13. AWS API Reference¶
13.1. AWS¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2018, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
package AWS with Pure is
Version : constant String := "20.0";
HTTP_10 : constant String := "HTTP/1.0";
HTTP_11 : constant String := "HTTP/1.1";
HTTP_Version : String renames HTTP_11;
end AWS;
13.2. AWS.Attachments¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Strings.Unbounded;
with AWS.Headers;
with AWS.MIME;
with AWS.Net;
private with Ada.Containers.Vectors;
package AWS.Attachments is
use Ada.Strings.Unbounded;
type Element is private;
type List is tagged private;
Empty_List : constant List;
type Content is private;
type Encoding is (None, Base64);
function File
(Filename : String;
Encode : Encoding := None;
Content_Id : String := "";
Content_Type : String := MIME.Text_Plain) return Content;
-- A filename as content, if Encode is set to Base64 the file content will
-- be base64 encoded.
function Value
(Data : Unbounded_String;
Name : String := "";
Encode : Encoding := None;
Content_Id : String := "";
Content_Type : String := MIME.Text_Plain) return Content;
-- An unbounded string as content
function Value
(Data : String;
Name : String := "";
Encode : Encoding := None;
Content_Id : String := "";
Content_Type : String := MIME.Text_Plain) return Content
is (Value (To_Unbounded_String (Data), Name, Encode, Content_Id,
Content_Type));
-- A string as content
type Attachment_Kind is (Data, Alternative);
-- Data : for a standard MIME attachment
-- Alternative : for a set of alternative content
procedure Add
(Attachments : in out List;
Filename : String;
Content_Id : String;
Headers : AWS.Headers.List := AWS.Headers.Empty_List;
Name : String := "";
Encode : Encoding := None)
with Post => Count (Attachments) = Count (Attachments'Old) + 1;
-- Adds an Attachment to the list.
-- Note that the encoding will overwrite the corresponding entry in
-- headers.
procedure Add
(Attachments : in out List;
Filename : String;
Headers : AWS.Headers.List;
Name : String := "";
Encode : Encoding := None)
with Post => Count (Attachments) = Count (Attachments'Old) + 1;
-- Adds an Attachment to the list.
-- Note that the encoding will overwrite the corresponding entry in
-- headers.
procedure Add
(Attachments : in out List;
Name : String;
Data : Content;
Headers : AWS.Headers.List := AWS.Headers.Empty_List)
with Post => Count (Attachments) = Count (Attachments'Old) + 1;
-- Adds an Attachment to the list.
-- Note that the encoding and content type attached to Data will
-- overwrite the corresponding entry in headers.
-- Alternatives content
type Alternatives is private;
procedure Add
(Parts : in out Alternatives;
Data : Content);
-- Add an alternative content
procedure Add
(Attachments : in out List;
Parts : Alternatives);
-- Add an alternative group to the current attachment list
procedure Reset
(Attachments : in out List;
Delete_Files : Boolean)
with Post => Count (Attachments) = 0;
-- Reset the list to be empty. If Delete_Files is set to true the
-- attached files are removed from the file system.
function Count (Attachments : List) return Natural with Inline;
-- Returns the number of Attachments in the data
function Get
(Attachments : List;
Index : Positive) return Element
with Pre => Index <= Count (Attachments);
-- Returns specified Attachment
function Get
(Attachments : List;
Content_Id : String) return Element
with
Pre =>
(for some K in 1 .. Count (Attachments)
=> AWS.Attachments.Content_Id (Get (Attachments, K)) = Content_Id);
-- Returns the Attachment with the Content Id
generic
with procedure Action
(Attachment : Element;
Index : Positive;
Quit : in out Boolean);
procedure For_Every_Attachment (Attachments : List);
-- Calls action for every Attachment in Message. Stop iterator if Quit is
-- set to True, Quit is set to False by default.
procedure Iterate
(Attachments : List;
Process : not null access procedure (Attachment : Element));
-- Calls Process for every Attachment in Message
function Headers (Attachment : Element) return AWS.Headers.List with Inline;
-- Returns the list of header lines for the attachment
function Content_Type (Attachment : Element) return String;
-- Get value for "Content-Type:" header
function Content_Id (Attachment : Element) return String;
-- Returns Attachment's content id
function Local_Filename (Attachment : Element) return String;
-- Returns the local filename of the Attachment.
-- Local filename is the name the receiver used when extracting the
-- Attachment into a file.
function Filename (Attachment : Element) return String;
-- Original filename on the server side. This is generally encoded on the
-- content-type or content-disposition header.
function Kind (Attachment : Element) return Attachment_Kind with Inline;
-- Returns the kind of the given attachment
function Length
(Attachments : List;
Boundary : String) return Positive
with Post => Length'Result > 8;
-- Returns the complete size of all attachments including the surrounding
-- boundaries.
procedure Send_MIME_Header
(Socket : Net.Socket_Type'Class;
Attachments : List;
Boundary : out Unbounded_String;
Alternative : Boolean := False);
-- Output MIME header, returns the boundary for the content
procedure Send
(Socket : AWS.Net.Socket_Type'Class;
Attachments : List;
Boundary : String);
-- Send all Attachments, including the surrounding boundarys, in the list
-- to the socket.
type Root_MIME_Kind is (Multipart_Mixed, Multipart_Alternative);
function Root_MIME (Attachments : List) return Root_MIME_Kind;
-- Returns the root MIME kind for the given attachment list
private
-- implementation removed
end AWS.Attachments;
13.3. AWS.Client¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2018, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Streams;
with Ada.Strings.Unbounded;
with AWS.Attachments;
with AWS.Default;
with AWS.Headers;
with AWS.Net.SSL.Certificate;
with AWS.Response;
private with Ada.Exceptions;
private with Ada.Finalization;
private with Ada.Real_Time;
private with ZLib;
private with AWS.URL;
private with AWS.Utils;
package AWS.Client is
use Ada.Streams;
use Ada.Strings.Unbounded;
Connection_Error : exception;
-- Raised if the connection with the server cannot be established
Protocol_Error : exception;
-- Raised if the client receives wrong HTTP protocol data
No_Data : constant String;
-- Used as the default parameter when no data specified for a specific
-- parameter.
Retry_Default : constant := 0;
-- Number of time a data is requested from the Server if the first
-- time fails.
--------------
-- Timeouts --
--------------
type Timeouts_Values is private;
-- Defined the duration for the connect, send, receive and complete
-- response receive timeouts.
No_Timeout : constant Timeouts_Values;
-- No timeout, allow infinite time to send or retrieve data
function Timeouts
(Connect : Duration := Net.Forever;
Send : Duration := Net.Forever;
Receive : Duration := Net.Forever;
Response : Duration := Net.Forever) return Timeouts_Values;
-- Constructor for the timeouts values
function Timeouts (Each : Duration) return Timeouts_Values;
-- Constructor for the timeouts values, sets all timeouts values (see
-- Contructor above) to Each.
function Connect_Timeout (T : Timeouts_Values) return Duration with Inline;
-- Returns the corresponding timeout value
function Send_Timeout (T : Timeouts_Values) return Duration with Inline;
-- Returns the corresponding timeout value
function Receive_Timeout (T : Timeouts_Values) return Duration with Inline;
-- Returns the corresponding timeout value
function Response_Timeout (T : Timeouts_Values) return Duration with Inline;
-- Returns the corresponding timeout value
--------------
-- Messages --
--------------
type Content_Bound is new Integer range -1 .. Integer'Last;
Undefined : constant Content_Bound := -1;
type Content_Range is record
First, Last : Content_Bound := Undefined;
end record;
-- Range for partial download
No_Range : constant Content_Range := (Undefined, Undefined);
type Authentication_Mode is new AWS.Response.Authentication_Mode;
type Authentication_Level is private;
type Authentication_Type is private;
type Auth_Attempts_Count is private;
subtype Header_List is Headers.List;
Empty_Header_List : constant Header_List := Headers.Empty_List;
subtype Attachment_List is Attachments.List;
Empty_Attachment_List : constant Attachment_List := Attachments.Empty_List;
function Get
(URL : String;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Data_Range : Content_Range := No_Range;
Follow_Redirection : Boolean := False;
Certificate : String := Default.Client_Certificate;
Headers : Header_List := Empty_Header_List;
User_Agent : String := Default.User_Agent)
return Response.Data;
-- Retrieve the message data given a specific URL. It open a connection
-- with the server and ask for the resource specified in the URL it then
-- return it in the Response.Data structure.
-- If User/Pwd are given then it uses it to access the URL.
--
-- Optionally it connects through a PROXY using if necessary the Proxy
-- authentication Proxy_User:Proxy_Pwd.
--
-- Only Basic authentication is supported (i.e. Digest is not). Digest
-- authentication is supported with the keep-alive client API, see below.
--
-- If Follow_Redirection is set to True, Get will follow the redirection
-- information for 301 status code response. Note that this is not
-- supported for keep-alive connections as the redirection could point to
-- another server.
--
-- Get will retry one time if it fails.
function Head
(URL : String;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Headers : Header_List := Empty_Header_List;
User_Agent : String := Default.User_Agent) return Response.Data;
-- Idem as above but we do not get the message body.
-- Head will retry one time if it fails.
function Put
(URL : String;
Data : String;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Headers : Header_List := Empty_Header_List;
User_Agent : String := Default.User_Agent) return Response.Data;
-- Send to the server URL a PUT request with Data
-- Put will retry one time if it fails.
function Delete
(URL : String;
Data : String;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Headers : Header_List := Empty_Header_List;
User_Agent : String := Default.User_Agent) return Response.Data;
-- Send to the server URL a DELETE request with Data
-- Delete will retry one time if it fails.
function Delete
(URL : String;
Data : Stream_Element_Array;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Headers : Header_List := Empty_Header_List;
User_Agent : String := Default.User_Agent) return Response.Data;
-- Send to the server URL a DELETE request with Data
-- Delete will retry one time if it fails.
function Post
(URL : String;
Data : String;
Content_Type : String := No_Data;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Attachments : Attachment_List := Empty_Attachment_List;
Headers : Header_List := Empty_Header_List;
User_Agent : String := Default.User_Agent)
return Response.Data;
-- Send to the server URL a POST request with Data
-- Post will retry one time if it fails.
function Post
(URL : String;
Data : Stream_Element_Array;
Content_Type : String := No_Data;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Attachments : Attachment_List := Empty_Attachment_List;
Headers : Header_List := Empty_Header_List;
User_Agent : String := Default.User_Agent)
return Response.Data;
-- Idem as above but with binary data
function SOAP_Post
(URL : String;
Data : String;
SOAPAction : String;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Attachments : Attachment_List := Empty_Attachment_List;
Headers : Header_List := Empty_Header_List;
User_Agent : String := Default.User_Agent)
return Response.Data;
-- Send to the server URL a POST request with Data
-- Post will retry one time if it fails.
function Upload
(URL : String;
Filename : String;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Timeouts : Timeouts_Values := No_Timeout;
Headers : Header_List := Empty_Header_List;
Progress : access procedure
(Total, Sent : Stream_Element_Offset) := null;
User_Agent : String := Default.User_Agent)
return Response.Data;
-- This is a file upload request. Filename file's content will be send to
-- the server at address URL.
---------------------------------------
-- Keep-Alive client implementation --
---------------------------------------
type HTTP_Connection is limited private;
type HTTP_Connection_Access is access all HTTP_Connection;
function Create
(Host : String;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Retry : Natural := Retry_Default;
Persistent : Boolean := True;
Timeouts : Timeouts_Values := No_Timeout;
Server_Push : Boolean := False;
Certificate : String := Default.Client_Certificate;
User_Agent : String := Default.User_Agent)
return HTTP_Connection;
procedure Create
(Connection : in out HTTP_Connection;
Host : String;
User : String := No_Data;
Pwd : String := No_Data;
Proxy : String := No_Data;
Proxy_User : String := No_Data;
Proxy_Pwd : String := No_Data;
Retry : Natural := Retry_Default;
Persistent : Boolean := True;
Timeouts : Timeouts_Values := No_Timeout;
Server_Push : Boolean := False;
SSL_Config : Net.SSL.Config := Net.SSL.Null_Config;
Certificate : String := Default.Client_Certificate;
User_Agent : String := Default.User_Agent);
-- Create a new connection. This is to be used with Keep-Alive client API
-- below. The connection will be tried Retry times if it fails. If
-- persistent is True the connection will remain open otherwise it will be
-- closed after each request. User/Pwd are the server authentication info,
-- Proxy is the name of the proxy server to use, Proxy_User/Proxy_Pwd are
-- the proxy authentication data. Only Basic authentication is supported
-- from this routine, for Digest authentication see below. Timeouts are
-- the send/receive timeouts for each request. If Server_Push is True the
-- connection will be used to push information to the client.
-- SSL_Config is to define secure connection configuration. Othewhise
-- Certificate can be set to specify the certificate filename to use for
-- the secure connection. User_Agent can be overridden to whatever you want
-- the client interface to present itself to the server.
function Get_Certificate
(Connection : HTTP_Connection) return Net.SSL.Certificate.Object;
-- Return the certificate used for the secure connection. If this is not a
-- secure connection, returns Net.SSL.Certificate.Undefined.
function Host (Connection : HTTP_Connection) return String;
-- Returns the host as recorded into the connection
procedure Set_Headers
(Connection : in out HTTP_Connection; Headers : Header_List) with Inline;
-- Set additional headers for connection
procedure Set_WWW_Authentication
(Connection : in out HTTP_Connection;
User : String;
Pwd : String;
Mode : Authentication_Mode);
-- Sets the username password and authentication mode for the Web
-- authentication.
--
-- "Any" mean that user want to use Digest server authentication mode but
-- could use Basic if the server does not support Digest authentication.
--
-- "Basic" mean that client will send basic authentication. "Basic"
-- authentication is send with the first request and is a fast
-- authentication protocol.
--
-- "Digest" mean that the client ask for Digest authentication, it
-- requires that a first unauthorized request be sent to the server. The
-- server will answer "nonce" for the authentication protocol to continue.
procedure Set_Proxy_Authentication
(Connection : in out HTTP_Connection;
User : String;
Pwd : String;
Mode : Authentication_Mode);
-- Sets the username, password and authentication mode for the proxy
-- authentication.
procedure Set_Persistent
(Connection : in out HTTP_Connection; Value : Boolean) with Inline;
-- Change Persistent flag of the connection. If persistent is True the
-- connection will remain open, otherwise it will be closed after each
-- request, next request and further would be with "Connection: Close"
-- header line.
procedure Clear_SSL_Session (Connection : in out HTTP_Connection);
-- Avoid reuse SSL session data after reconnect
procedure Copy_Cookie
(Source : HTTP_Connection;
Destination : in out HTTP_Connection);
-- Copy a session Id from connection Source to connection Destination.
-- Allow both connections to share the same user environment. Note that
-- user's environment are thread-safe.
function Get_Cookie (Connection : HTTP_Connection) return String
with Inline;
-- Get the connection cookie
procedure Set_Cookie
(Connection : in out HTTP_Connection; Cookie : String) with Inline;
-- Set the connection cookie
function Cipher_Description (Connection : HTTP_Connection) return String;
function SSL_Session_Id (Connection : HTTP_Connection) return String;
-- Returns base64 encoded SSL session identifier.
-- Returns empty string for plain HTTP connections and for not connected
-- SSL HTTP connections.
function Read_Until
(Connection : HTTP_Connection;
Delimiter : String;
Wait : Boolean := True) return String;
-- Read data on the Connection until the delimiter (including the
-- delimiter). It can be used to retrieve the next piece of data from a
-- push server. If Wait is False the routine is looking for delimiter only
-- in the internal socket buffer and return empty string if no delimiter
-- found. If Wait is True and returned data is empty or does not termintate
-- with the delimiter the server push connection is closed.
procedure Read_Until
(Connection : in out HTTP_Connection;
Delimiter : String;
Result : in out Unbounded_String;
Wait : Boolean := True);
-- Idem as above but returns the result as an Unbounded_String
procedure Read_Some
(Connection : in out HTTP_Connection;
Data : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- Reads any available data from the client's connection.
-- If no data available, it will wait for some data to become available or
-- until it timeouts. Returns Last < Data'First when there is no data
-- available in the HTTP response. Connection have to be created with
-- parameter Server_Push => True.
procedure Read
(Connection : in out HTTP_Connection;
Data : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- Reads data from the client's connection until Data buffer if filled
-- or it reached the end of the response. Returns Last < Data'Last if
-- there is no more data available in HTTP response. Connection have
-- to be created with parameter Server_Push => True.
procedure Get
(Connection : in out HTTP_Connection;
Result : out Response.Data;
URI : String := No_Data;
Data_Range : Content_Range := No_Range;
Headers : Header_List := Empty_Header_List);
-- Same as Get above but using a Connection
procedure Head
(Connection : in out HTTP_Connection;
Result : out Response.Data;
URI : String := No_Data;
Headers : Header_List := Empty_Header_List);
-- Same as Head above but using a Connection
procedure Delete
(Connection : in out HTTP_Connection;
Result : out Response.Data;
Data : String;
URI : String := No_Data;
Headers : Header_List := Empty_Header_List);
-- Same as Delete above but using a Connection
procedure Delete
(Connection : in out HTTP_Connection;
Result : out Response.Data;
Data : Stream_Element_Array;
URI : String := No_Data;
Headers : Header_List := Empty_Header_List);
-- Same as Delete above but using a Connection
procedure Put
(Connection : in out HTTP_Connection;
Result : out Response.Data;
Data : String;
URI : String := No_Data;
Headers : Header_List := Empty_Header_List);
-- Same as Put above but using a Connection
procedure Put
(Connection : in out HTTP_Connection;
Result : out Response.Data;
Data : Stream_Element_Array;
URI : String := No_Data;
Headers : Header_List := Empty_Header_List);
procedure Post
(Connection : in out HTTP_Connection;
Result : out Response.Data;
Data : String;
Content_Type : String := No_Data;
URI : String := No_Data;
Attachments : Attachment_List := Empty_Attachment_List;
Headers : Header_List := Empty_Header_List);
-- Same as Post above but using a Connection
procedure Post
(Connection : in out HTTP_Connection;
Result : out Response.Data;
Data : Stream_Element_Array;
Content_Type : String := No_Data;
URI : String := No_Data;
Attachments : Attachment_List := Empty_Attachment_List;
Headers : Header_List := Empty_Header_List);
-- Same as Post above but using a Connection
procedure Upload
(Connection : in out HTTP_Connection;
Result : out Response.Data;
Filename : String;
URI : String := No_Data;
Headers : Header_List := Empty_Header_List;
Progress : access procedure
(Total, Sent : Stream_Element_Offset) := null);
-- Same as Upload above but using a Connection
procedure SOAP_Post
(Connection : HTTP_Connection;
Result : out Response.Data;
SOAPAction : String;
Data : String;
Streaming : Boolean := False;
Attachments : Attachment_List := Empty_Attachment_List;
Headers : Header_List := Empty_Header_List);
-- Same as SOAP_Post above but using a Connection
-- Streaming is to be able to parse response XML on the fly,
-- without intermediate buffer.
procedure Close (Connection : in out HTTP_Connection);
-- Close connection, it releases all associated resources
procedure Set_Streaming_Output
(Connection : in out HTTP_Connection;
Value : Boolean)
with Inline;
-- Call this routine with Value => True to be able to read data as a
-- stream by using Read and/or Read_Some routines above. Note that
-- Connection is already in Streaming mode if it has been created
-- with Server_Push => True.
procedure Set_Debug (On : Boolean);
-- Set debug mode on/off. If debug is activated the request header and the
-- server response header will be displayed.
function Get_Socket (Connection : HTTP_Connection) return Net.Socket_Access;
-- Retrieve the socket used for the connection
private
-- implementation removed
end AWS.Client;
13.4. AWS.Client.Hotplug¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with AWS.Response;
package AWS.Client.Hotplug is
-- Below are two routines to register/unregister hotplug modules into
-- server. Note that such server must be configured to accept hotplug
-- modules. Password parameter is the clear text paswword, it will be sent
-- encoded. An authorization entry for module Name with Password (and the
-- given URL host for registration) must be found in the server's
-- authorization file. See AWS.Server.Hotplug.Activate.
function Register
(Name : String;
Password : String;
Server : String;
Regexp : String;
URL : String) return Response.Data;
-- Register hotplug module Name into Server with address URL to respond to
-- requests matching Regexp. Server must be a valid URL, http://host:port.
-- If port is not specified the default HTTP port is used.
function Unregister
(Name : String;
Password : String;
Server : String;
Regexp : String) return Response.Data;
-- Unregister hotplug module Name responding to Regexp requests from
-- Server. See comment above about Password.
end AWS.Client.Hotplug;
13.5. AWS.Communication¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- The communication protocol uses a light encoding scheme based on the HTTP
-- GET method. For standard, XML based, communication you can use the SOAP
-- protocol. This API can be convenient if you do not plan to build AWS with
-- SOAP support.
with Ada.Strings.Unbounded;
package AWS.Communication is
use Ada.Strings.Unbounded;
type Parameter_Set is array (Positive range <>) of Unbounded_String;
Null_Parameter_Set : constant Parameter_Set;
function Parameters
(P1, P2, P3, P4, P5 : String := "") return Parameter_Set;
-- Constructor function to help create a Parameter_Set. This function will
-- return a Parameter_Set array containing any parameter with a non emptry
-- string value.
private
-- implementation removed
end AWS.Communication;
13.6. AWS.Communication.Client¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with AWS.Response;
package AWS.Communication.Client is
function Send_Message
(Server : String;
Port : Positive;
Name : String;
Parameters : Parameter_Set := Null_Parameter_Set)
return Response.Data;
-- Send a message to server with a set of parameters. The destination is
-- server is http://Server:Port, the message name is Name and the set of
-- parameters is to be found into Parameters.
--
-- The complete message format is:
--
-- http://<Server>:<Port>/AWS_Com?HOST=<host>&NAME=<name>
-- &P1=<param1>&P2=<param2>
end AWS.Communication.Client;
13.7. AWS.Communication.Server¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with AWS.Response;
generic
type T (<>) is limited private; -- Data type received by this server
type T_Access is access T;
with function Callback
(Server : String; -- Host name
Name : String; -- Message name
Context : not null access T;
Parameters : Parameter_Set := Null_Parameter_Set)
return Response.Data;
package AWS.Communication.Server is
-- Each instantiation of this package will create an HTTP server waiting
-- for incoming requests at the Port specified in the Start formal
-- parameter. This communication server must be started with the Start
-- procedure and can be stopped with the procedure Shutdown below.
procedure Start (Port : Positive; Context : T_Access; Host : String := "");
-- Start communication HTTP server listening at the given port
procedure Shutdown;
-- Shutdown the communication HTTP server
end AWS.Communication.Server;
13.8. AWS.Config¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2019, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This package provide an easy way to handle server configuration options.
--
-- If initialization of this package is not done all functions below will
-- return the default value as declared in AWS.Default.
with System;
with GNAT.Regexp;
private with Ada.Strings.Unbounded;
private with AWS.Containers.String_Vectors;
private with AWS.Default;
package AWS.Config is
type Object is private;
Default_Config : constant Object;
-- For the external configuration to be loaded either Get_Current or
-- Load_Config must be called explicitely.
function Get_Current return Object;
-- Returns a configuration record. This is the properties as read in files
-- 'aws.ini' and 'progname.ini'. This configuration object holds only the
-- per-server options.
procedure Load_Config;
-- Load configuration and store it into an internal object. This can be
-- called when only some server-wide configuration are to be set from
-- .ini files for example.
------------------------
-- Per Server options --
------------------------
------------
-- Server --
------------
function Server_Name (O : Object) return String with Inline;
-- This is the name of the server as set by AWS.Server.Start
function Protocol_Family (O : Object) return String with Inline;
-- Server protocol family. Family_Inet for IPv4, Family_Inet6 for IPv6 and
-- Family_Unspec for unspecified protocol family.
function IPv6_Only (O : Object) return Boolean with Inline;
-- IPv6 server accepts only IPv6 connections
function Server_Host (O : Object) return String with Inline;
-- This is the server host. Can be used if the computer has a more than
-- one IP address. It is possible to have two servers at the same port
-- on the same machine, both being binded on different IP addresses.
function Server_Port (O : Object) return Natural with Inline;
-- This is the server port as set by the HTTP object declaration
function Hotplug_Port (O : Object) return Positive with Inline;
-- This is the hotplug communication port needed to register and
-- un-register an hotplug module.
function Session (O : Object) return Boolean with Inline;
-- Returns True if the server session is activated
function Case_Sensitive_Parameters (O : Object) return Boolean with Inline;
-- HTTP parameters are case sensitive
function Session_Name (O : Object) return String with Inline;
-- Name of the cookie session
function Session_Private_Name (O : Object) return String with Inline;
-- Name of the private cookie session
function Server_Priority (O : Object) return System.Any_Priority
with Inline;
-- Returns the priority used by the HTTP and WebSockets servers
function Server_Header (O : Object) return String with Inline;
-- Returns the Server header value
----------------
-- Connection --
----------------
function Max_Connection (O : Object) return Positive with Inline;
-- This is the max simultaneous connections as set by the HTTP object
-- declaration.
function Send_Buffer_Size (O : Object) return Natural with Inline;
-- This is the socket buffer size used for sending data. Increasing this
-- value will give better performances on slow or long distances
-- connections.
function TCP_No_Delay (O : Object) return Boolean with Inline;
-- Returns wether the TCP_NODELAY option is set for this server
function Free_Slots_Keep_Alive_Limit (O : Object) return Natural
with Inline;
-- The minimum number of free slots where keep-alive connections are still
-- enabled. After this limit no more keep-alive connection will be
-- accepted by the server. This parameter must be used for heavy-loaded
-- servers to make sure the server will never run out of slots. This limit
-- must be less than Max_Connection.
function Keep_Alive_Force_Limit (O : Object) return Positive with Inline;
-- Server could have more than Max_Connection keep-alive sockets. Keep
-- alive sockets are waiting for client input in the internal server socket
-- set. This parameter defines the maximum number of keep alive sockets
-- processed by the server with standard timeouts. If number of keep-alive
-- sockets becomes more than Keep_Alive_Force_Limit the server starts to
-- use shorter timeouts. If this parameter is not defined in the
-- configuration, the server uses Max_Connection * 2 as value.
function Keep_Alive_Close_Limit (O : Object) return Positive with Inline;
-- This parameter defines the limit of keep alive sockets in the internal
-- server socket set. If the number of sockets in socket set became more
-- than Keep_Alive_Close_Limit, most close to timeout socket would be
-- closed. If this parameter is not defined in the configuration,
-- the server uses Max_Connection * 4 as value.
function Accept_Queue_Size (O : Object) return Positive with Inline;
-- This is the size of the queue for the incoming requests. Higher this
-- value will be and less "connection refused" will be reported to the
-- client.
function Line_Stack_Size (O : Object) return Positive with Inline;
-- HTTP lines stack size
function Reuse_Address (O : Object) return Boolean with Inline;
-- Returns true if bind is allowed to reuse an address (not waiting for
-- the delay between two bind to the same port).
----------
-- Data --
----------
function WWW_Root (O : Object) return String with Inline;
-- This is the root directory name for the server. This variable is not
-- used internally by AWS. It is supposed to be used by the callback
-- procedures who want to retrieve physical objects (images, Web pages...).
-- The default value is the current working directory. The returned
-- directory ends with a directory separator.
function Upload_Directory (O : Object) return String with Inline;
-- This point to the directory where uploaded files will be stored. The
-- directory returned will end with a directory separator.
function Upload_Size_Limit (O : Object) return Positive with Inline;
-- Size limit for the client uploading data before calling the user's
-- callback or dispatcher handler. User can call
-- AWS.Status.Is_Body_Uploaded to check if client data is uploaded or not
-- because of this limit. User can still approve the uploading data above
-- this limit by using AWS.Server.Get_Message_Body.
function Directory_Browser_Page (O : Object) return String with Inline;
-- Filename for the directory browser template page
function Max_POST_Parameters (O : Object) return Positive with Inline;
-- Returns the maximum number of POST parameters handled. Past this limit
-- the exception Too_Many_Parameters is raised.
---------
-- Log --
---------
function Log_Activated (O : Object) return Boolean with Inline;
-- Whether the default log should be activated
function Log_File_Directory (O : Object) return String with Inline;
-- This point to the directory where log files will be written. The
-- directory returned will end with a directory separator.
function Log_Filename_Prefix (O : Object) return String with Inline;
-- This is the prefix to use for the log filename
function Log_Split_Mode (O : Object) return String with Inline;
-- This is split mode for the log file. Possible values are : Each_Run,
-- Daily, Monthly and None. Any other values will raise an exception.
function Log_Size_Limit (O : Object) return Natural with Inline;
generic
with procedure Field_Id (Id : String);
procedure Log_Extended_Fields_Generic_Iterate (O : Object);
-- Calls procedure Field_Id for each extended http log field identifier
function Log_Extended_Fields_Length (O : Object) return Natural with Inline;
-- Returns the number of extended http log fileds identifiers.
-- If returned value is zero then http log is not extended.
function Error_Log_Activated (O : Object) return Boolean with Inline;
-- Whether the error log should be activated
function Error_Log_Filename_Prefix (O : Object) return String with Inline;
-- This is the prefix to use for the log filename
function Error_Log_Split_Mode (O : Object) return String with Inline;
-- This is split mode for the log file. Possible values are : Each_Run,
-- Daily, Monthly and None. Any other values will raise an exception.
------------
-- Status --
------------
function Admin_Password (O : Object) return String with Inline;
-- The admin password
function Admin_Realm (O : Object) return String with Inline;
-- The admin password
function Admin_URI (O : Object) return String with Inline;
-- This is the name of the admin server page as set by AWS.Server.Start.
-- It is also known as the status page.
function Status_Page (O : Object) return String with Inline;
-- Filename for the status template page
function Up_Image (O : Object) return String with Inline;
-- Filename for the up arrow image used in the status page
function Down_Image (O : Object) return String with Inline;
-- Filename for the down arrow image used in the status page
function Logo_Image (O : Object) return String with Inline;
-- Filename for the AWS logo image used in the status page
--------------
-- Timeouts --
--------------
function Cleaner_Wait_For_Client_Timeout (O : Object) return Duration
with Inline;
-- Number of seconds to timout on waiting for a client request.
-- This is a timeout for regular cleaning task.
function Cleaner_Client_Header_Timeout (O : Object) return Duration
with Inline;
-- Number of seconds to timout on waiting for client header.
-- This is a timeout for regular cleaning task.
function Cleaner_Client_Data_Timeout (O : Object) return Duration
with Inline;
-- Number of seconds to timout on waiting for client message body.
-- This is a timeout for regular cleaning task.
function Cleaner_Server_Response_Timeout (O : Object) return Duration
with Inline;
-- Number of seconds to timout on waiting for client to accept answer.
-- This is a timeout for regular cleaning task.
function Force_Wait_For_Client_Timeout (O : Object) return Duration
with Inline;
-- Number of seconds to timout on waiting for a client request.
-- This is a timeout for urgent request when resources are missing.
function Force_Client_Header_Timeout (O : Object) return Duration
with Inline;
-- Number of seconds to timout on waiting for client header.
-- This is a timeout for urgent request when resources are missing.
function Force_Client_Data_Timeout (O : Object) return Duration with Inline;
-- Number of seconds to timout on waiting for client message body.
-- This is a timeout for urgent request when resources are missing.
function Force_Server_Response_Timeout (O : Object) return Duration
with Inline;
-- Number of seconds to timout on waiting for client to accept answer.
-- This is a timeout for urgent request when resources are missing.
function Send_Timeout (O : Object) return Duration with Inline;
-- Number of seconds to timeout when sending chunck of data
function Receive_Timeout (O : Object) return Duration with Inline;
-- Number of seconds to timeout when receiving chunck of data
--------------
-- Security --
--------------
function Check_URL_Validity (O : Object) return Boolean with Inline;
-- Server have to check URI for validity. For example it checks that an
-- URL does not reference a resource above the Web root.
function Security (O : Object) return Boolean with Inline;
-- Is the server working through th SSL
function Certificate (O : Object) return String with Inline;
-- Returns the certificate to be used with the secure server. Returns the
-- empty string if the server is not a secure one.
function Key (O : Object) return String with Inline;
-- Returns the key to be used with the secure server. Returns the
-- empty string if the server is not a secure one.
function Security_Mode (O : Object) return String with Inline;
-- Returns the security mode to be used with the secure server. Returns the
-- empty string if the server is not a secure one.
function Cipher_Priorities (O : Object) return String with Inline;
-- Returns the cipher priorities for the security communication
function TLS_Ticket_Support (O : Object) return Boolean with Inline;
-- Is security communication side has support stateless TLS session
-- resumption. See RFC 5077.
function Exchange_Certificate (O : Object) return Boolean with Inline;
-- Returns True if the client is requested to send its certificate to the
-- server.
function Certificate_Required (O : Object) return Boolean with Inline;
-- Returns True if the server must abort the connection if the
-- client did not provide trusted certificate. If this option is set
-- the Exchange_Certificate must also be set.
function Trusted_CA (O : Object) return String with Inline;
-- Returns the filename containing a list of trusted CA, this is to be used
-- with the Exchange_Certificate option. The filename is on bundle of CAs
-- that can be trusted. A client certificate signed with one of those CA
-- will be accetped by the server.
function CRL_File (O : Object) return String with Inline;
-- Returns the filename containing the Certificate Revocation List. This
-- list is used by the server to check for revoked certificate.
function SSL_Session_Cache_Size (O : Object) return Natural with Inline;
-- Returns SSL session cashe size
-------------------------
-- Per Process options --
-------------------------
function Session_Cleanup_Interval return Duration with Inline;
-- Number of seconds between each run of the cleaner task to remove
-- obsolete session data.
function Session_Lifetime return Duration with Inline;
-- Number of seconds to keep a session if not used. After this period the
-- session data is obsoleted and will be removed during next cleanup.
function Session_Id_Length return Positive with Inline;
-- Returns the length (number of characters) of the session id
function Session_Cleaner_Priority return System.Any_Priority with Inline;
-- Returns the priority used by the session cleaner task
function Service_Priority return System.Any_Priority with Inline;
-- Returns the priority used by the others services (SMTP server, Jabber
-- server, Push server...).
function Config_Directory return String with Inline;
-- Directory where AWS parameter files are located
function Transient_Cleanup_Interval return Duration with Inline;
-- Number of seconds between each run of the cleaner task to remove
-- transient pages.
function Transient_Lifetime return Duration with Inline;
-- Number of seconds to keep a transient page. After this period the
-- transient page is obsoleted and will be removed during next cleanup.
function Max_Concurrent_Download return Positive with Inline;
-- Number of maximum concurrent download supported by the download manager
-- service.
function MIME_Types return String with Inline;
-- Returns the file name of the MIME types to use
function Input_Line_Size_Limit return Positive with Inline;
-- Limit of the HTTP protocol text lines length
function Context_Lifetime return Duration with Inline;
-- Number of seconds to keep a context if not used. After this period the
-- context data is obsoleted and will be removed during next cleanup.
function Max_WebSocket_Handler return Positive with Inline;
-- This is the max simultaneous connections handling WebSocket's messages
function WebSocket_Message_Queue_Size return Positive with Inline;
-- This is the size of the queue containing incoming messages
function WebSocket_Send_Message_Queue_Size return Positive with Inline;
-- This is the size of the queue containing messages to send
function Max_WebSocket return Positive with Inline;
-- The maximum number of simultaneous WebSocket opened. Note that that
-- there could be more WebSocket registered when counting the closing
-- WebSockets.
function WebSocket_Timeout return Duration with Inline;
-- Returns the WebSocket activity timeout. After this number of seconds
-- without any activity the WebSocket can be closed when needed.
function Is_WebSocket_Origin_Set return Boolean with Inline;
-- Returns True if the Origin has been set
function WebSocket_Origin return GNAT.Regexp.Regexp;
-- This is regular expression to restrict WebSocket to a specific origin
function WebSocket_Origin return String;
-- This is the string regular expression to restrict WebSocket to a
-- specific origin.
function WebSocket_Priority return System.Any_Priority;
-- Set the priority used by the WebSocket service
function User_Agent return String with Inline;
-- Returns the User_Agent header value
private
-- implementation removed
end AWS.Config;
13.9. AWS.Config.Ini¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Handle .ini style configuration files. In those files each option is on one
-- line. The first word is the option name and the second one is the option
-- value.
package AWS.Config.Ini is
function Program_Ini_File (Full_Path : Boolean) return String;
-- Returns initialization filename for current server (using the
-- executable name and adding .ini).
procedure Read
(Config : in out Object;
Filename : String);
-- Read Filename and update the configuration object with the
-- options read from it. Raises Ada.Text_IO.Name_Error if Filename does
-- not exist. Raises Constraint_Error in case of wrong any parameter name
-- or value.
end AWS.Config.Ini;
13.10. AWS.Config.Set¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2019, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- This package can be used to Set any AWS parameters
package AWS.Config.Set is
------------------------
-- Per Server Options --
------------------------
------------
-- Server --
------------
procedure Server_Name (O : in out Object; Value : String);
-- This is the name of the server as set by AWS.Server.Start
procedure Protocol_Family (O : in out Object; Value : String);
-- Set the server protocol family. Family_Inet for IPv4, Family_Inet6 for
-- IPv6 and Family_Unspec for unspecified protocol family.
procedure IPv6_Only (O : in out Object; Value : Boolean);
-- Set the mode when IPv6 server allows connect only IPv6 clients
procedure Server_Host (O : in out Object; Value : String);
-- This is the server host as set by the HTTP object declaration
procedure Server_Port (O : in out Object; Value : Natural);
-- This is the server port as set by the HTTP object declaration
procedure Hotplug_Port (O : in out Object; Value : Positive);
-- This is the hotplug communication port needed to register and
-- un-register an hotplug module.
procedure Session (O : in out Object; Value : Boolean);
-- Enable session handling is Value is True
procedure Case_Sensitive_Parameters (O : in out Object; Value : Boolean);
-- Parameters are handled with the case if Value is True
procedure Line_Stack_Size (O : in out Object; Value : Positive);
-- HTTP lines stack size
procedure Reuse_Address (O : in out Object; Value : Boolean);
-- Set the reuse address policy allowing a bind without a dealy to the same
-- address and port.
procedure Session_Name (O : in out Object; Value : String);
-- Name of the cookie session
procedure Server_Priority (O : in out Object; Value : System.Any_Priority);
-- Set the priority used by the HTTP and WebSockets servers
procedure Server_Header (O : in out Object; Value : String);
-- Set the server header (value used by the Server: request header)
----------------
-- Connection --
----------------
procedure Max_Connection (O : in out Object; Value : Positive);
-- This is the max simultaneous connections as set by the HTTP object
-- declaration.
procedure Send_Buffer_Size (O : in out Object; Value : Positive);
-- This is the socket buffer size used for sending data. Increasing this
-- value will give better performances on slow or long distances
-- connections.
procedure TCP_No_Delay (O : in out Object; Value : Boolean);
-- Set the TCP_NODELAY option for this server
procedure Free_Slots_Keep_Alive_Limit
(O : in out Object; Value : Natural);
-- The minimum number of free slots where keep-alive connections are still
-- enabled. After this limit no more keep-alive connection will be
-- accepted by the server. This parameter must be used for heavy-loaded
-- servers to make sure the server will never run out of slots. This limit
-- must be less than Max_Connection.
procedure Keep_Alive_Force_Limit (O : in out Object; Value : Natural);
-- Define maximum number of keep alive sockets where server process it with
-- normal timeouts. If number of keep-alive sockets become more than
-- Keep_Alive_Force_Limit, server start to use shorter force timeouts.
-- If this parameter not defined in configuration or defined as 0 value
-- server use calculated value Max_Connection * 2.
procedure Accept_Queue_Size (O : in out Object; Value : Positive);
-- This is the size of the queue for the incoming requests. Higher this
-- value will be and less "connection refused" will be reported to the
-- client.
----------
-- Data --
----------
procedure WWW_Root (O : in out Object; Value : String);
-- This is the root directory name for the server. This variable is not
-- used internally by AWS. It is supposed to be used by the callback
-- procedures who want to retrieve physical objects (images, Web
-- pages...). The default value is the current working directory.
procedure Upload_Directory (O : in out Object; Value : String);
-- This point to the directory where uploaded files will be stored. The
-- directory returned will end with a directory separator.
procedure Upload_Size_Limit (O : in out Object; Value : Positive);
-- Set the maximum size accepted for uploaded files
procedure Directory_Browser_Page (O : in out Object; Value : String);
-- Filename for the directory browser template page
procedure Max_POST_Parameters (O : in out Object; Value : Positive);
-- Set the maximum number of POST parameters handled. Past this limit
-- the exception Too_Many_Parameters is raised.
---------
-- Log --
---------
procedure Log_Activated (O : in out Object; Value : Boolean);
-- Whether the default log should be activated
procedure Log_File_Directory (O : in out Object; Value : String);
-- This point to the directory where log files will be written. The
-- directory returned will end with a directory separator.
procedure Log_Filename_Prefix (O : in out Object; Value : String);
-- This is the prefix to use for the log filename
procedure Log_Size_Limit (O : in out Object; Value : Natural);
-- If Log_Size_Limit is more than zero and size of log file
-- become more than Log_Size_Limit, log file is be split.
procedure Log_Split_Mode (O : in out Object; Value : String);
-- This is split mode for the log file. Possible values are : Each_Run,
-- Daily, Monthly and None. Any other values will raise an exception.
procedure Log_Extended_Fields (O : in out Object; Value : String);
-- Comma separated list of the extended log field names. If this parameter
-- is empty, the HTTP log would have fixed apache compartible format:
--
-- 127.0.0.1 - - [25/Apr/1998:15:37:29 +0200] "GET / HTTP/1.0" 200 1363
--
-- If the extended fields list is not empty, the log file format would have
-- user defined fields set:
--
-- #Version: 1.0
-- #Date: 2006-01-09 00:00:01
-- #Fields: date time cs-method cs-uri cs-version sc-status sc-bytes
-- 2006-01-09 00:34:23 GET /foo/bar.html HTTP/1.1 200 30
--
-- Fields in the list could be:
--
-- date Date at which transaction completed
-- time Time at which transaction completed
-- c-ip Client side connected IP address
-- c-port Client side connected port
-- s-ip Server side connected IP address
-- s-port Server side connected port
-- cs-method HTTP request method
-- cs-username Client authentication username
-- cs-version Client supported HTTP version
-- cs-uri Request URI
-- cs-uri-stem Stem portion alone of URI (omitting query)
-- cs-uri-query Query portion alone of URI
-- sc-status Responce status code
-- sc-bytes Length of response message body
-- cs(<header>) Any header field name sent from client to server
-- sc(<header>) Any header field name sent from server to client
-- x-<appfield> Any application defined field name
procedure Error_Log_Activated (O : in out Object; Value : Boolean);
-- Whether the error log should be activated
procedure Error_Log_Filename_Prefix (O : in out Object; Value : String);
-- This is the prefix to use for the log filename
procedure Error_Log_Split_Mode (O : in out Object; Value : String);
-- This is split mode for the log file. Possible values are : Each_Run,
-- Daily, Monthly and None. Any other values will raise an exception.
------------
-- Status --
------------
procedure Admin_Password (O : in out Object; Value : String);
-- This is the password for the admin server page as set by
-- AWS.Server.Start. The password must be created with the aws_password
-- tool.
procedure Admin_URI (O : in out Object; Value : String);
-- This is the name of the admin server page as set by AWS.Server.Start
procedure Status_Page (O : in out Object; Value : String);
-- Filename for the status template page
procedure Up_Image (O : in out Object; Value : String);
-- Filename for the up arrow image used in the status page
procedure Down_Image (O : in out Object; Value : String);
-- Filename for the down arrow image used in the status page
procedure Logo_Image (O : in out Object; Value : String);
-- Filename for the AWS logo image used in the status page
--------------
-- Timeouts --
--------------
procedure Cleaner_Wait_For_Client_Timeout
(O : in out Object;
Value : Duration);
-- Number of seconds to timout on waiting for a client request.
-- This is a timeout for regular cleaning task.
procedure Cleaner_Client_Header_Timeout
(O : in out Object;
Value : Duration);
-- Number of seconds to timout on waiting for client header.
-- This is a timeout for regular cleaning task.
procedure Cleaner_Client_Data_Timeout
(O : in out Object;
Value : Duration);
-- Number of seconds to timout on waiting for client message body.
-- This is a timeout for regular cleaning task.
procedure Cleaner_Server_Response_Timeout
(O : in out Object;
Value : Duration);
-- Number of seconds to timout on waiting for client to accept answer.
-- This is a timeout for regular cleaning task.
procedure Force_Wait_For_Client_Timeout
(O : in out Object;
Value : Duration);
-- Number of seconds to timout on waiting for a client request.
-- This is a timeout for urgent request when resources are missing.
procedure Force_Client_Header_Timeout
(O : in out Object;
Value : Duration);
-- Number of seconds to timout on waiting for client header.
-- This is a timeout for urgent request when resources are missing.
procedure Force_Client_Data_Timeout
(O : in out Object;
Value : Duration);
-- Number of seconds to timout on waiting for client message body.
-- This is a timeout for urgent request when resources are missing.
procedure Force_Server_Response_Timeout
(O : in out Object;
Value : Duration);
-- Number of seconds to timout on waiting for client to accept answer.
-- This is a timeout for urgent request when resources are missing.
procedure Send_Timeout (O : in out Object; Value : Duration);
-- Number of seconds to timeout when sending chunck of data
procedure Receive_Timeout (O : in out Object; Value : Duration);
-- Number of seconds to timeout when receiving chunck of data
--------------
-- Security --
--------------
procedure Check_URL_Validity (O : in out Object; Value : Boolean);
-- Set the check URL validity flag. If True an URL that reference a
-- resource above the Web root will be rejected.
procedure Security (O : in out Object; Value : Boolean);
-- Enable security (HTTPS/SSL) if Value is True
procedure Certificate (O : in out Object; Filename : String);
-- Set the certificate filename in PEM format to be used with the secure
-- server.
procedure Key (O : in out Object; Filename : String);
-- Set the key to be used with the secure server
procedure Security_Mode (O : in out Object; Mode : String);
-- Set the security mode to be used with the secure server. Only values
-- from AWS.Net.SSL.Method can be used.
procedure Cipher_Priorities (O : in out Object; Value : String);
-- Sets priorities for the cipher suites supported by SSL implementation.
-- GNUTLS and OpenSSL implementations has different sintax for this
-- parameter.
procedure TLS_Ticket_Support (O : in out Object; Value : Boolean);
-- Set to True for security communication side support stateless TLS
-- session resumption. See RFC 5077.
procedure Exchange_Certificate (O : in out Object; Value : Boolean);
-- Set to True to request the client to send its certificate to the server
procedure Certificate_Required (O : in out Object; Value : Boolean);
-- Returns True if the server must abort the connection if the
-- client did not provide a certificate. If this option is set
-- the Exchange_Certificate must also be set.
procedure Trusted_CA (O : in out Object; Filename : String);
-- Returns the filename containing a list of trusted CA, this is to be used
-- with the Exchange_Certificate option. The filename is on bundle of CAs
-- that can be trusted. A client certificate signed with one of those CA
-- will be accetped by the server.
procedure CRL_File (O : in out Object; Filename : String);
-- Returns the filename containing the Certificate Revocation List. This
-- list is used by the server to check for revoked certificate.
procedure SSL_Session_Cache_Size (O : in out Object; Value : Natural);
-------------------------
-- Per Process Options --
-------------------------
procedure Session_Cleanup_Interval (Value : Duration);
-- Number of seconds between each run of the cleaner task to remove
-- obsolete session data.
procedure Session_Lifetime (Value : Duration);
-- Number of seconds to keep a session if not used. After this period the
-- session data is obsoleted and will be removed during next cleanup.
procedure Session_Id_Length (Value : Positive);
-- Returns the length (number of characters) of the session id
procedure Session_Cleaner_Priority (Value : System.Any_Priority);
-- Set the priority used by the session cleaner task
procedure Service_Priority (Value : System.Any_Priority);
-- Set the priority used by the others services (SMTP server, Jabber
-- server, Push server...).
procedure Config_Directory (Value : String);
-- Directory where AWS parameter files are located
procedure Transient_Cleanup_Interval (Value : Duration);
-- Number of seconds between each run of the cleaner task to remove
-- transient pages.
procedure Transient_Lifetime (Value : Duration);
-- Number of seconds to keep a transient page. After this period the
-- transient page is obsoleted and will be removed during next cleanup.
procedure Context_Lifetime (Value : Duration);
-- Number of seconds to keep a context if not used. After this period the
-- context data is obsoleted and will be removed during next cleanup.
procedure Max_Concurrent_Download (Value : Positive);
-- Control the maximum number of parallel downloads accepted by the
-- download manager.
procedure Max_WebSocket (Value : Positive);
-- The maximum number of simultaneous WebSocket opened. Note that that
-- there could be more WebSocket registered when counting the closing
-- WebSockets.
procedure Max_WebSocket_Handler (Value : Positive);
-- This is the max simultaneous connections handling WebSocket's messages
procedure MIME_Types (Value : String);
-- The name of the file containing the MIME types associations
procedure WebSocket_Message_Queue_Size (Value : Positive);
-- This is the size of the queue containing incoming messages
procedure WebSocket_Send_Message_Queue_Size (Value : Positive);
-- This is the size of the queue containing messages to send
procedure WebSocket_Origin (Value : String);
-- This is regular expression to restrict WebSocket to a specific origin
procedure WebSocket_Priority (Value : System.Any_Priority);
-- Set the priority used by the WebSocket service
procedure WebSocket_Timeout (Value : Duration);
-- Returns the WebSocket activity timeout. After this number of seconds
-- without any activity the WebSocket can be closed when needed.
procedure Input_Line_Size_Limit (Value : Positive);
-- Maximum length of an HTTP parameter
procedure User_Agent (Value : String);
-- Set the user agent for client request heaser
procedure Parameter
(Config : in out Object;
Name : String;
Value : String;
Error_Context : String := "");
-- Set one of the AWS HTTP per server parameters. Raises Constraint_Error
-- in case of wrong parameter name or wrong parameter value.
-- Error_Context may contain additional information about the parameter.
-- This message will be added to the Constraint_Error exception.
-- One way to use Error_Context is to set it with information about
-- where this parameter come form.
procedure Parameter
(Name : String;
Value : String;
Error_Context : String := "");
-- Set one of the AWS HTTP per process parameters. See description above
end AWS.Config.Set;
13.11. AWS.Containers.Tables¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Strings.Unbounded;
private with Ada.Containers.Indefinite_Ordered_Maps;
private with Ada.Containers.Indefinite_Vectors;
private with Ada.Containers.Vectors;
package AWS.Containers.Tables is
use Ada.Strings.Unbounded;
type Table_Type is tagged private;
Empty_Table : constant Table_Type;
type Element is record
Name : Unbounded_String;
Value : Unbounded_String;
end record;
-- Data type to store name/value pair retrieved from a Table_Type
Null_Element : constant Element;
type VString_Array is array (Positive range <>) of Unbounded_String;
function Count (Table : Table_Type) return Natural;
-- Returns the number of items in Table
function Is_Empty (Table : Table_Type) return Boolean;
-- Returns true if table is empty
function Name_Count (Table : Table_Type) return Natural;
-- Returns the number of unique key name in Table
function Case_Sensitive (Table : Table_Type) return Boolean with Inline;
-- Returns case sensitivity flag of the Table
function Count (Table : Table_Type; Name : String) return Natural;
-- Returns the number of value for Key Name in Table. It returns
-- 0 if Key does not exist.
function Exist (Table : Table_Type; Name : String) return Boolean;
-- Returns True if Key exist in Table
function Get
(Table : Table_Type;
Name : String;
N : Positive := 1) return String
with Post => (if N > Count (Table, Name) then Get'Result'Length = 0);
-- Returns the Nth value associated with Key into Table. Returns
-- the emptry string if key does not exist.
function Get_Name
(Table : Table_Type; N : Positive := 1) return String
with Post => (if N > Count (Table) then Get_Name'Result'Length = 0);
-- Returns the Nth Name in Table or the empty string if there is
-- no parameter with this number.
function Get_Value
(Table : Table_Type; N : Positive := 1) return String
with Post => (if N > Count (Table) then Get_Value'Result'Length = 0);
-- Returns the Nth Value in Table or the empty string if there is
-- no parameter with this number.
function Get (Table : Table_Type; N : Positive) return Element with
Post => (if N > Count (Table) then Get'Result = Null_Element);
-- Returns N'th name/value pair. Returns Null_Element if there is no
-- such item in the table.
function Get_Names (Table : Table_Type) return VString_Array
with Post => Get_Names'Result'Length = Name_Count (Table);
-- Returns sorted array of unique key names
function Get_Values
(Table : Table_Type; Name : String) return VString_Array
with Post => Get_Values'Result'Length = Count (Table, Name);
-- Returns all values for the specified parameter key name
generic
with procedure Process (Name, Value : String);
procedure Generic_Iterate_Names
(Table : Table_Type; Separator : String);
-- Iterates over all names in the table.
-- All Values of the same name are separated by Separator string.
procedure Iterate_Names
(Table : Table_Type;
Separator : String;
Process : not null access procedure (Name, Value : String));
function Union
(Left : Table_Type;
Right : Table_Type;
Unique : Boolean) return Table_Type;
-- Concatenates two tables, If Unique is True do not add Right container
-- element into result when element with the same name already exists in
-- the Left container.
procedure Add (Table : in out Table_Type; Name, Value : String);
procedure Add
(Table : in out Table_Type;
Name, Value : Unbounded_String)
with Post => Count (Table) = Count (Table'Old) + 1
or else
Count (Table, To_String (Name))
= Count (Table'Old, To_String (Name)) + 1;
-- Add a new Key/Value pair into Table. A new value is always added,
-- even if there is already an entry with the same name.
procedure Update
(Table : in out Table_Type;
Name : String;
Value : String;
N : Positive := 1);
procedure Update
(Table : in out Table_Type;
Name : Unbounded_String;
Value : Unbounded_String;
N : Positive := 1)
with
Pre =>
-- Count + 1 means it is added at the end of the table
N <= Count (Table, To_String (Name)) + 1,
Post =>
-- Value already exists, it is updated
(N <= Count (Table'Old, To_String (Name))
and then Count (Table, To_String (Name))
= Count (Table'Old, To_String (Name)))
-- New value appended
or else
(N = Count (Table'Old, To_String (Name)) + 1
and then N = Count (Table, To_String (Name)));
-- Update the N-th Value with the given Name into the Table.
-- The container could already have more than one value associated with
-- this name.
procedure Case_Sensitive
(Table : in out Table_Type;
Mode : Boolean);
-- If Mode is True it will use all parameters with case sensitivity
procedure Reset (Table : in out Table_Type) with
Post => Count (Table) = 0;
-- Removes all object from Table. Table will be reinitialized and will be
-- ready for new use.
private
-- implementation removed
end AWS.Containers.Tables;
13.12. AWS.Cookie¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2010-2018, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- A package for basic HTTP state management, ie. cookies. Tokens and
-- attributes adhere to RFC-2109: http://tools.ietf.org/html/rfc2109
with AWS.Default;
with AWS.Response;
with AWS.Status;
package AWS.Cookie is
use type AWS.Response.Data_Mode;
Response_Data_Not_Initialized : exception;
-- The Response_Data_Not_Initialized exception is raised when trying to add
-- headers to an un-initialized AWS.Response.Data object.
-- The AWS.Response.Data object is initialized using the
-- AWS.Response.Build function.
No_Max_Age : constant Duration;
-- When no Max-Age is required, this value can be passed to the Set
-- routines below.
function Exists
(Request : Status.Data;
Key : String;
Case_Sensitive : Boolean := True) return Boolean;
-- Check if the 'Key' cookie exists in AWS.Headers.List. Return Boolean
-- True of the cookie exists, else Boolean False.
procedure Expire
(Content : in out Response.Data;
Key : String;
Path : String := "/");
-- Expire the 'Key' cookie. This is done by setting the Max-Age attribute
-- to 0. The Value of the cookie is also set to "", in case a browser does
-- not honor the Max-Age attribute.
function Get
(Request : Status.Data;
Key : String;
Case_Sensitive : Boolean := True) return String;
-- Return the 'Key' cookie from AWS.Headers.List. If the cookie does not
-- exist, return an empty string, ie. ""
function Get
(Request : Status.Data;
Key : String;
Case_Sensitive : Boolean := True) return Integer;
-- Return the 'Key' cookie from AWS.Headers.List. If the cookie does not
-- exist or can't be converted from String to Integer then return 0.
function Get
(Request : Status.Data;
Key : String;
Case_Sensitive : Boolean := True) return Float;
-- Return the 'Key' cookie from AWS.Headers.List. If the cookie does not
-- exist or can't be converted from String to Float then return 0.0.
function Get
(Request : Status.Data;
Key : String;
Case_Sensitive : Boolean := True) return Boolean;
-- Return the 'Key' cookie from AWS.Headers.List. Only if the cookie value
-- equals "True" is Boolean True returned, else Boolean False is returned.
procedure Set
(Content : in out Response.Data;
Key : String;
Value : String;
Comment : String := "";
Domain : String := "";
Max_Age : Duration := Default.Ten_Years;
Path : String := "/";
Secure : Boolean := False;
HTTP_Only : Boolean := False)
with Pre => Response.Mode (Content) /= Response.No_Data;
-- Set a new cookie named 'Key' with value 'Value'. See RFC 2109 for more
-- information about the individual cookie attributes:
-- http://tools.ietf.org/html/rfc2109
--
-- Exceptions:
-- Response_Data_Not_Initialized
-- Is raised if AWS.Cookie.Set is called before the Content object has
-- been initialized by a call to AWS.Response.Build
procedure Set
(Content : in out Response.Data;
Key : String;
Value : Integer;
Comment : String := "";
Domain : String := "";
Max_Age : Duration := Default.Ten_Years;
Path : String := "/";
Secure : Boolean := False;
HTTP_Only : Boolean := False)
with Pre => Response.Mode (Content) /= Response.No_Data;
-- Set a new cookie named 'Key' with Integer value 'Value'. The Integer is
-- converted to a String, as both cookie keys and values are inherently
-- strings.
--
-- Exceptions:
-- Response_Data_Not_Initialized
-- Is raised if AWS.Cookie.Set is called before the Content object has
-- been initialized by a call to AWS.Response.Build
procedure Set
(Content : in out Response.Data;
Key : String;
Value : Float;
Comment : String := "";
Domain : String := "";
Max_Age : Duration := Default.Ten_Years;
Path : String := "/";
Secure : Boolean := False;
HTTP_Only : Boolean := False)
with Pre => Response.Mode (Content) /= Response.No_Data;
-- Set a new cookie named 'Key' with Float value 'Value'. The Float is
-- converted to a String, as both cookie keys and values are inherently
-- strings.
--
-- Exceptions:
-- Response_Data_Not_Initialized
-- Is raised if AWS.Cookie.Set is called before the Content object has
-- been initialized by a call to AWS.Response.Build
procedure Set
(Content : in out Response.Data;
Key : String;
Value : Boolean;
Comment : String := "";
Domain : String := "";
Max_Age : Duration := Default.Ten_Years;
Path : String := "/";
Secure : Boolean := False;
HTTP_Only : Boolean := False)
with Pre => Response.Mode (Content) /= Response.No_Data;
-- Set a new cookie named 'Key' with Boolean value 'Value'. The Boolean is
-- converted to a String ("False" or "True"), as both cookie keys and
-- values are inherently strings.
--
-- Exceptions:
-- Response_Data_Not_Initialized
-- Is raised if AWS.Cookie.Set is called before the Content object has
-- been initialized by a call to AWS.Response.Build
private
-- implementation removed
end AWS.Cookie;
13.13. AWS.Default¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2019, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This package contains the default AWS configuration values. These values
-- are used to initialize the configuration objects. Users should not modify
-- the values here, see AWS.Config.* API.
with System;
package AWS.Default with Pure is
use System;
-- All times are in seconds
Ten_Years : constant := 86_400.0 * 365 * 10;
One_Hour : constant := 3_600.0;
One_Minute : constant := 60.0;
Eight_Hours : constant := 8.0 * One_Hour;
Three_Hours : constant := 3.0 * One_Hour;
Three_Minutes : constant := 3.0 * One_Minute;
Five_Minutes : constant := 5.0 * One_Minute;
Ten_Minutes : constant := 10.0 * One_Minute;
-- Server configuration
Server_Name : constant String := "AWS Module";
WWW_Root : constant String := "./";
Admin_URI : constant String := "";
Admin_Password : constant String := "";
Admin_Realm : constant String := "AWS Admin Page";
Protocol_Family : constant String := "FAMILY_UNSPEC";
IPv6_Only : constant Boolean := False;
Server_Port : constant := 8080;
Hotplug_Port : constant := 8888;
Max_Connection : constant := 5;
Max_WebSocket_Handler : constant := 2;
Max_WebSocket : constant := 512;
WebSocket_Message_Queue_Size : constant := 10;
WebSocket_Send_Message_Queue_Size : constant := 30;
WebSocket_Timeout : constant Duration := Eight_Hours;
Send_Buffer_Size : constant := 0;
TCP_No_Delay : constant Boolean := False;
Free_Slots_Keep_Alive_Limit : constant := 1;
Keep_Alive_Force_Limit : constant := 0;
Keep_Alive_Close_Limit : constant := 0;
Accept_Queue_Size : constant := 64;
Upload_Directory : constant String := "";
Upload_Size_Limit : constant := 16#500_000#;
Line_Stack_Size : constant := 16#150_000#;
Case_Sensitive_Parameters : constant Boolean := True;
Input_Line_Size_Limit : constant := 16#4000#;
Max_POST_Parameters : constant := 100;
Max_Concurrent_Download : constant := 25;
Reuse_Address : constant Boolean := False;
MIME_Types : constant String := "aws.mime";
-- Client configuration
User_Agent : constant String :=
"AWS (Ada Web Server) v" & Version;
Server_Header : constant String :=
User_Agent;
-- Log values. The character '@' in the error log filename prefix is
-- replaced by the running program name.
Log_Activated : constant Boolean := False;
Log_File_Directory : constant String := "./";
Log_Split_Mode : constant String := "NONE";
Log_Filename_Prefix : constant String := "@";
Error_Log_Activated : constant Boolean := False;
Error_Log_Split_Mode : constant String := "NONE";
Error_Log_Filename_Prefix : constant String := "@_error";
Log_Size_Limit : constant Natural := 0;
-- Session
Session : constant Boolean := False;
Session_Name : constant String := "AWS";
Session_Private_Name : constant String := "AWS_Private";
Session_Cleanup_Interval : constant Duration := Five_Minutes;
Session_Lifetime : constant Duration := Ten_Minutes;
Session_Id_Length : constant Positive := 11;
-- Context
Context_Lifetime : constant Duration := Eight_Hours;
-- Transient pages
Transient_Cleanup_Interval : constant Duration := Three_Minutes;
Transient_Lifetime : constant Duration := Five_Minutes;
-- Server's timeouts
Cleaner_Wait_For_Client_Timeout : constant Duration := 80.0;
Cleaner_Client_Header_Timeout : constant Duration := 7.0;
Cleaner_Client_Data_Timeout : constant Duration := Eight_Hours;
Cleaner_Server_Response_Timeout : constant Duration := Eight_Hours;
Force_Wait_For_Client_Timeout : constant Duration := 2.0;
Force_Client_Header_Timeout : constant Duration := 2.0;
Force_Client_Data_Timeout : constant Duration := Three_Hours;
Force_Server_Response_Timeout : constant Duration := Three_Hours;
Send_Timeout : constant Duration := 40.0;
Receive_Timeout : constant Duration := 30.0;
-- Directory template
Directory_Browser_Page : constant String := "aws_directory.thtml";
-- Status page
Status_Page : constant String := "aws_status.thtml";
Up_Image : constant String := "aws_up.png";
Down_Image : constant String := "aws_down.png";
Logo_Image : constant String := "aws_logo.png";
-- Security
Security : constant Boolean := False;
Security_Mode : constant String := "TLS";
Config_Directory : constant String := ".config/ada-web-srv";
Cipher_Priorities : constant String := "";
TLS_Ticket_Support : constant Boolean := False;
Certificate : constant String := "cert.pem";
Key : constant String := "";
Client_Certificate : constant String := "";
Exchange_Certificate : constant Boolean := False;
Certificate_Required : constant Boolean := False;
Trusted_CA : constant String := "";
CRL_File : constant String := "";
Check_URL_Validity : constant Boolean := True;
SSL_Session_Cache_Size : constant := 16#4000#;
-- Priorities
Server_Priority : constant Any_Priority := Default_Priority;
WebSocket_Priority : constant Any_Priority := Default_Priority;
Session_Cleaner_Priority : constant Any_Priority := Default_Priority;
Service_Priority : constant Any_Priority := Default_Priority;
end AWS.Default;
13.14. AWS.Dispatchers¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This package provides a service to build Callbacks which can support
-- user's data. It is possible to build a new dispatcher by inheriting the
-- handler type and to provides the Dispatch routine.
with Ada.Finalization;
with AWS.Response;
with AWS.Status;
with AWS.Utils;
package AWS.Dispatchers is
type Handler is abstract new Ada.Finalization.Controlled
and AWS.Utils.Clonable with private;
function Dispatch
(Dispatcher : Handler;
Request : Status.Data) return Response.Data is abstract;
-- Call the appropriate inherited dispatcher
function Ref_Counter (Dispatcher : Handler) return Natural;
-- Returns the reference counter for Handler. If 0 is returned then this
-- object is not referenced anymore, it is safe to deallocate resources.
type Handler_Class_Access is access all Handler'Class;
procedure Free (Dispatcher : in out Handler_Class_Access) with Inline;
-- Release memory associated with the dispatcher
private
-- implementation removed
end AWS.Dispatchers;
13.15. AWS.Dispatchers.Callback¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2013, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- Dispatch on a Callback procedure
with AWS.Dispatchers;
with AWS.Response;
with AWS.Status;
package AWS.Dispatchers.Callback is
type Handler is new Dispatchers.Handler with private;
-- This is a simple wrapper around standard callback procedure (access to
-- function). It will be used to build dispatchers services and for the
-- main server callback.
function Create (Callback : Response.Callback) return Handler
with Inline;
-- Build a dispatcher for the specified callback
private
-- implementation removed
end AWS.Dispatchers.Callback;
13.16. AWS.Exceptions¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with Ada.Exceptions;
with AWS.Log;
with AWS.Response;
with AWS.Status;
package AWS.Exceptions is
use Ada.Exceptions;
type Data is record
Fatal : Boolean;
-- If True it means that we go a fatal error. The slot will be
-- terminated so AWS will loose one of it's simultaneous connection.
-- This is clearly an AWS internal error that should be fixed in AWS.
Slot : Positive;
-- The failing slot number
Request : Status.Data;
-- The complete request information that was served when the slot has
-- failed. This variable is set only when Fatal is False.
end record;
type Unexpected_Exception_Handler is not null access
procedure (E : Exception_Occurrence;
Log : in out AWS.Log.Object;
Error : Data;
Answer : in out Response.Data);
-- Unexpected exception handler can be set to monitor server errors.
-- Answer can be set with the answer to send back to the client's
-- browser. Note that this is possible only for non fatal error
-- (i.e. Error.Fatal is False).
-- Log is the error log object for the failing server, it can be used
-- to log user's information (if error log is activated for this
-- server). Note that the server will have already logged information
-- about the problem.
end AWS.Exceptions;
13.17. AWS.Headers¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with AWS.Containers.Tables;
with AWS.Net;
package AWS.Headers is
type List is new AWS.Containers.Tables.Table_Type with private;
-- Header container. This set handles a set of HTTP header line, each new
-- header line is inserted at the end of the list (see AWS.Headers.Set API)
-- and can be retrieved by the following services. Header lines are
-- numbered from 1 to N.
Empty_List : constant List;
subtype VString_Array is AWS.Containers.Tables.VString_Array;
subtype Element is AWS.Containers.Tables.Element;
Format_Error : exception;
-- Raised when header line format is wrong
procedure Send_Header (Socket : Net.Socket_Type'Class; Headers : List);
-- Send all header lines in Headers list to the socket
function Get_Line (Headers : List; N : Positive) return String with
Post =>
(N > Count (Headers) and then Get_Line'Result'Length = 0)
or else N <= Count (Headers);
-- Returns the Nth header line in Headers container. The returned value is
-- formatted as a correct header line:
--
-- message-header = field-name ":" [ field-value ]
--
-- That is the header-name followed with character ':' and the header
-- values. If there is less than Nth header line it returns the empty
-- string. Note that this routine does returns all header line values, for
-- example it would return:
--
-- Content_Type: multipart/mixed; boundary="0123_The_Boundary_Value_"
--
-- For a file upload content type header style.
function Get_Values (Headers : List; Name : String) return String;
-- Returns all values for the specified header field Name in a
-- comma-separated string. This format is conformant to [RFC 2616 - 4.2]
-- (see last paragraph).
function Length (Headers : AWS.Headers.List) return Natural;
-- Returns the length (in bytes) of the header, including the ending
-- empty line.
procedure Read (Headers : in out List; Socket : Net.Socket_Type'Class);
-- Read and parse HTTP header from the socket
overriding procedure Reset (Headers : in out List)
with Post => Headers.Count = 0;
-- Removes all object from Headers. Headers will be reinitialized and will
-- be ready for new use.
procedure Debug (Activate : Boolean);
-- Turn on Debug output
-- See AWS.Containers.Tables for inherited routines
private
-- implementation removed
end AWS.Headers;
13.18. AWS.Headers.Values¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded;
package AWS.Headers.Values is
use Ada.Strings.Unbounded;
Format_Error : exception renames Headers.Format_Error;
-- Data represent a token from an header line. There is two kinds of
-- token, either named or un-named.
--
-- Content-Type: xyz boundary="uvt"
--
-- Here xyz is an un-named value and uvt a named value the name is
-- boundary.
type Data (Named_Value : Boolean := True) is record
Value : Unbounded_String;
case Named_Value is
when True =>
Name : Unbounded_String;
when False =>
null;
end case;
end record;
type Set is array (Positive range <>) of Data;
-----------
-- Parse --
-----------
generic
with procedure Value (Item : String; Quit : in out Boolean);
-- Called for every un-named value read from the header value
with procedure Named_Value
(Name : String;
Value : String;
Quit : in out Boolean);
-- Called for every named value read from the header value
procedure Parse (Header_Value : String);
-- Look for un-named values and named ones (Name="Value" pairs) in the
-- header line, and call appropriate routines when found. Quit is set to
-- False before calling Value or Named_Value, the parsing can be stopped
-- by setting Quit to True.
-------------------
-- Split / Index --
-------------------
function Split (Header_Value : String) return Set;
-- Returns a Set with each named and un-named values splited from Data
function Index
(Set : Values.Set;
Name : String;
Case_Sensitive : Boolean := True) return Natural;
-- Returns index for Name in the set or 0 if Name not found.
-- If Case_Sensitive is false the find is case_insensitive.
---------------------------
-- Other search routines --
---------------------------
function Search
(Header_Value : String;
Name : String;
Case_Sensitive : Boolean := True) return String;
-- Returns Value for Name in Header_Value or the empty string if Name not
-- found. If Case_Sensitive is False the search is case insensitive.
function Get_Unnamed_Value
(Header_Value : String; N : Positive := 1) return String;
-- Returns N-th un-named value from Header_Value
function Unnamed_Value_Exists
(Header_Value : String;
Value : String;
Case_Sensitive : Boolean := True) return Boolean;
-- Returns True if the unnamed value specified has been found in
-- Header_Value.
end AWS.Headers.Values;
13.19. AWS.Jabber¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2013, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
package AWS.Jabber with Pure is
end AWS.Jabber;
13.20. AWS.LDAP.Client¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Provides an API to add, read, modify and delete information from a LDAP
-- server. It is a thick binding, see AWS.LDAP.Thin for a thin binding.
--
-- This API has been tested on Windows and Linux (OpenLDAP).
with Ada.Containers.Indefinite_Vectors;
with Ada.Exceptions;
with Ada.Strings.Unbounded;
with AWS.LDAP.Thin;
package AWS.LDAP.Client is
use Ada.Exceptions;
use Ada.Strings.Unbounded;
LDAP_Error : exception renames LDAP.LDAP_Error;
Default_Port : constant Positive := Positive (Thin.LDAP_PORT);
subtype Directory is Thin.LDAP_Type;
-- An LDAP directory. This object must be initialized with Init and Bind
-- and terminated with Unbind.
subtype LDAP_Message is Thin.LDAPMessage;
-- An LDAP message or set of messages. There is a set of iterators to
-- access all messages returned by the search procedure.
subtype BER_Element is Thin.BerElement;
-- An iterator structure. Initialized and used to iterate through all the
-- attributes for a specific message.
Null_Directory : constant Directory := Thin.Null_LDAP_Type;
Null_LDAP_Message : constant LDAP_Message := Thin.Null_LDAPMessage;
type Scope_Type is
(LDAP_Scope_Default, LDAP_Scope_Base,
LDAP_Scope_One_Level, LDAP_Scope_Subtree);
-- LDAP scope for the search
type String_Set is array (Positive range <>) of Unbounded_String;
-- A set of strings, this is used to map C array of strings (a char **)
-- from the thin binding.
Null_Set : constant String_Set;
function Get_Error (E : Exception_Occurrence) return Thin.Return_Code;
-- Returns the error code in the LDAP_Error exception occurence E. Returns
-- Think.LDAP_SUCCESS if no error code has been found.
----------------
-- Attributes --
----------------
subtype Attribute_Set is String_Set;
-- Used to represent the set of attributes to retrieve from the LDAP server
function Attributes
(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10 : String := "")
return Attribute_Set;
-- Returns a String_Set object containing only none empty values. Values
-- for S1 through S10 must be set in the order of the parameters. This is
-- an helper routine to help building an array of unbounded string from a
-- set of string.
function uid (Val : String := "") return String;
-- Returns the uid attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function givenName (Val : String := "") return String;
-- Returns the given name (firstname) attribute. if Val is specified
-- "=<Val>" is added after the attribute name.
function cn (Val : String := "") return String;
function commonName (Val : String := "") return String renames cn;
-- Returns the common Name attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function sn (Val : String := "") return String;
function surname (Val : String := "") return String renames sn;
-- Returns the surname attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function telephoneNumber (Val : String := "") return String;
-- Returns the phone number. if Val is specified "=<Val>" is
-- added after the attribute name. Val must use the international notation
-- according to CCITT E.123.
function mail (Val : String := "") return String;
-- Returns the mail attribute. if Val is specified "=<Val>" is added after
-- the attribute name.
function l (Val : String := "") return String;
function localityName (Val : String := "") return String renames l;
-- Returns the locality attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function o (Val : String := "") return String;
function organizationName (Val : String := "") return String renames o;
-- Returns the organization attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function ou (Val : String := "") return String;
function organizationalUnitName (Val : String := "") return String
renames ou;
-- Returns the organizational unit attribute, if Val is specified "=<Val>"
-- is added after the attribute name.
function st (Val : String := "") return String;
function stateOrProvinceName (Val : String := "") return String
renames st;
-- Returns the state name attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function c (Val : String := "") return String;
function countryName (Val : String) return String renames c;
-- Returns country code attribute, if Val is specified "=<Val>" is
-- added after the attribute name. Val must be a two-letter ISO 3166
-- country code.
function dc (Val : String := "") return String;
function domainComponent (Val : String := "") return String renames dc;
-- Returns a domain component attribute, if Val is specified "=<Val>" is
-- added after the attribute name.
function Cat
(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10 : String := "") return String;
-- Returns a string object containing only none empty values. Values for
-- S1 through S10 must be set in the order of the parameters. All values
-- are catenated and separated with a coma. This is an helper routine to
-- help building a filter objects or base distinguished name.
----------------
-- Initialize --
----------------
function Init
(Host : String;
Port : Positive := Default_Port) return Directory;
-- Must be called first, to initialize the LDAP communication with the
-- server. Returns Null_Directory in case of error.
procedure Bind
(Dir : Directory;
Login : String;
Password : String);
-- Bind to the server by providing a login and password
procedure Unbind (Dir : in out Directory);
-- Must be called to release resources associated with the Directory. Does
-- nothing if Dir is Null_Directory.
function Is_Open (Dir : Directory) return Boolean;
-- Returns True if the directory has correctly been initialized and binded
-- with the server.
------------
-- Search --
------------
function Search
(Dir : Directory;
Base : String;
Filter : String;
Scope : Scope_Type := LDAP_Scope_Default;
Attrs : Attribute_Set := Null_Set;
Attrs_Only : Boolean := False) return LDAP_Message;
-- Do a search on the LDAP server. Base is the name of the database.
-- Filter can be used to retrieve a specific set of entries. Attrs specify
-- the set of attributes to retrieve. If Attrs_Only is set to True only
-- the types are returned. Raises LDAP_Error in case of problem.
-----------------------
-- Add/Modify/Delete --
-----------------------
type Mod_Type is (LDAP_Mod_Add, LDAP_Mod_Replace, LDAP_Mod_BValues);
-- Modification types: Add, Replace and BER flag
type Mod_Element (Values_Size : Natural) is record
Mod_Op : Mod_Type;
Mod_Type : Unbounded_String;
Mod_Values : Attribute_Set (1 .. Values_Size);
end record;
-- Holds modification elements. 'Abstraction' of the LDAPMod_Element type
-- used in the thin-binding. Mod_Values is static to make it less complex.
package LDAP_Mods is
new Ada.Containers.Indefinite_Vectors (Positive, Mod_Element);
-- Vector-based Storage for all modification elements. Will be
-- mapped to C LDAPMod **.
procedure Add
(Dir : Directory;
DN : String;
Mods : LDAP_Mods.Vector);
-- Add an entry specified by 'DN' to the LDAP server. The Mods-Vector
-- contains the attributes for the entry.
procedure Modify
(Dir : Directory;
DN : String;
Mods : LDAP_Mods.Vector);
-- Modify an attribute of entry specified by 'DN'. The Mods-Vector
-- contains the attributes to add/replace/delete for the entry.
procedure Delete (Dir : Directory; DN : String);
-- Delete an entry specified by 'DN' from the LDAP server
---------------
-- Iterators --
---------------
function First_Entry
(Dir : Directory;
Chain : LDAP_Message) return LDAP_Message;
-- Returns the first entry (or Node) for the search result (Chain)
function Next_Entry
(Dir : Directory;
Entries : LDAP_Message) return LDAP_Message;
-- Returns next entry (or Node) for Entries
function Count_Entries
(Dir : Directory;
Chain : LDAP_Message) return Natural;
-- Returns the number of entries in the search result (Chain)
procedure Free (Chain : LDAP_Message);
-- Release memory associated with the search result Chain
generic
with procedure Action
(Node : LDAP_Message;
Quit : in out Boolean);
procedure For_Every_Entry (Dir : Directory; Chain : LDAP_Message);
-- This iterator call Action for each entry (Node) found in the LDAP result
-- set as returned by the search procedure. Quit can be set to True to
-- stop iteration; its initial value is False.
function First_Attribute
(Dir : Directory;
Node : LDAP_Message;
BER : not null access BER_Element) return String;
-- Returns the first attribute for the entry. It initialize an iteraror
-- (the BER structure). The BER structure must be released after used by
-- using the Free routine below.
function Next_Attribute
(Dir : Directory;
Node : LDAP_Message;
BER : BER_Element) return String;
-- Returns next attribute for iterator BER. First_Attribute must have been
-- called to initialize this iterator.
procedure Free (BER : BER_Element);
-- Releases memory associated with the BER structure which has been
-- allocated by the First_Attribute routine.
generic
with procedure Action
(Attribute : String;
Quit : in out Boolean);
procedure For_Every_Attribute
(Dir : Directory;
Node : LDAP_Message);
-- This iterator call action for each attribute found in the LDAP Entries
-- Node as returned by First_Entry or Next_Entry. Quit can be set to True
-- to stop iteration; its initial value is False.
---------------
-- Accessors --
---------------
function Get_DN
(Dir : Directory;
Node : LDAP_Message) return String;
-- Returns the distinguished name for the given entry Node
function DN2UFN (DN : String) return String;
-- Returns a distinguished name converted to a user-friendly format
function Get_Values
(Dir : Directory;
Node : LDAP_Message;
Target : String) return String_Set;
-- Returns the list of values of a given attribute (Target) found in entry
-- Node.
function Explode_DN
(DN : String;
No_Types : Boolean := True) return String_Set;
-- Breaks up an entry name into its component parts. If No_Types is set to
-- True the types information ("cn=") won't be included.
private
-- implementation removed
end AWS.LDAP.Client;
13.21. AWS.Log¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- This package handle the logging facility for AWS. The log file is named
-- '<progname>-Y-M-D.log' and is written by default in the directory where
-- the server is launched, see configuration file.
--
-- Note that this package is used internally by AWS to log server requests
-- but it can also be used by users to handle application's log.
--
-- This package is thread safe.
with AWS.Containers.String_Vectors;
with AWS.Headers;
with AWS.Messages;
with AWS.Response;
with AWS.Status;
private with Ada.Containers.Indefinite_Ordered_Maps;
private with Ada.Finalization;
private with Ada.Strings.Unbounded;
private with Ada.Text_IO;
private with AWS.Utils;
package AWS.Log is
type Object is limited private;
-- A log object. It must be activated by calling Start below
type Callback is access procedure (Message : String);
-- Access to a procedure that handles AWS access and/or error log data.
-- If the access and/or error logs are started with a Callback procedure
-- set, then AWS will no longer handle writing the log data to file, nor
-- will it rotate or split the data. In short : If you set a Callback, it's
-- up to you to handle these things.
-- The raw log data generated by AWS is simply handed verbatim to the
-- Callback procedure.
type Split_Mode is (None, Each_Run, Daily, Monthly);
-- It specifies when to create a new log file.
-- None : all log info gets accumulated into the same file.
-- Each_Run : a new log file is created each time the server is started.
-- Daily : a new log file is created each day.
-- Monthly : a new log file is created each month.
type Fields_Table is private;
-- Type to keep record for Extended Log File Format
Empty_Fields_Table : constant Fields_Table;
Not_Specified : constant String;
procedure Start
(Log : in out Object;
Split : Split_Mode := None;
Size_Limit : Natural := 0;
File_Directory : String := Not_Specified;
Filename_Prefix : String := Not_Specified;
Auto_Flush : Boolean := False);
-- Activate server's activity logging. Split indicate the way the log file
-- should be created. If Size_Limit more than zero and size of log file
-- become more than Size_Limit, log file would be splitted. Filename_Prefix
-- is the log filename prefix. If it is not specified the default prefix is
-- the program name. Set Auto_Flush to True if you want every write to the
-- log to be flushed (not buffered). Auto_Flush should be set to True only
-- for logs with few entries per second as the flush has a performance
-- penalty.
procedure Start
(Log : in out Object;
Writer : Callback;
Name : String);
-- Activate server's activity logging and send all log data to Callback.
-- When the logging object is started with a Callback no splitting or size
-- limits are imposed on the logging data. This will all have to be handled
-- in the Callback.
-- When a log is started with a Callback, all log data is passed verbatim
-- to the Callback.
-- The Name String is returned when the Filename function is called. This
-- serves no other function than to label the Callback procedure.
procedure Register_Field (Log : in out Object; Id : String);
-- Register field to be written into extended log format
procedure Set_Field
(Log : Object; Data : in out Fields_Table; Id, Value : String);
-- Set field value into the extended log record. Data could be used only
-- in one task and with one log file. Different tasks could write own Data
-- using the Write routine with Fields_Table parameter type.
procedure Set_Header_Fields
(Log : Object;
Data : in out Fields_Table;
Prefix : String;
Header : AWS.Headers.List);
-- Set header fields into extended log record.
-- Name of the header fields would be <Prefix>(<Header_Name>).
-- Prefix should be "cs" - Client to Server or "sc" - Server to Client.
procedure Write (Log : in out Object; Data : in out Fields_Table);
-- Write extended format record to log file and prepare record for the next
-- data. It is not allowed to use same Fields_Table with different extended
-- logs.
procedure Write
(Log : in out Object;
Connect_Stat : Status.Data;
Answer : Response.Data);
-- Write log info if activated (i.e. Start routine above has been called)
procedure Write
(Log : in out Object;
Connect_Stat : Status.Data;
Status_Code : Messages.Status_Code;
Content_Length : Response.Content_Length_Type);
-- Write log info if activated (i.e. Start routine above has been called).
-- This version separated the Content_Length from Status.Data, this is
-- required for example in the case of a user defined stream content. See
-- AWS.Resources.Stream.
procedure Write
(Log : in out Object;
Connect_Stat : Status.Data;
Data : String);
-- Write user's log info if activated. (i.e. Start routine above has been
-- called).
procedure Write (Log : in out Object; Data : String);
-- Write Data into the log file. This Data is unstructured, only a time
-- tag prefix is prepended to Data. This routine is designed to be used
-- for user's info in error log file.
procedure Flush (Log : in out Object);
-- Flush the data to the Log file, for be able to see last logged
-- messages.
-- If a Callback procedure is used to handle the log data, then calling
-- Flush does nothing.
procedure Stop (Log : in out Object);
-- Stop logging activity
function Is_Active (Log : Object) return Boolean;
-- Returns True if Log is activated
function Filename (Log : Object) return String;
-- Returns current log filename or the empty string if the log is not
-- activated.
-- If a Callback is used to handle the log, then the name given in the
-- Start procedure is returned. See the Start procedure for starting logs
-- with a Callback.
function Mode (Log : Object) return Split_Mode;
-- Returns the split mode. None will be returned if log is not activated or
-- a Callback procedure is used to handle the log data.
private
-- implementation removed
end AWS.Log;
13.22. AWS.Messages¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2018, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Calendar;
with Ada.Streams;
with Ada.Strings.Unbounded;
package AWS.Messages is
use Ada;
use Ada.Streams;
use Ada.Strings.Unbounded;
-----------------
-- HTTP tokens --
-----------------
HTTP_Token : constant String := "HTTP/";
Options_Token : constant String := "OPTIONS";
Get_Token : constant String := "GET";
Head_Token : constant String := "HEAD";
Post_Token : constant String := "POST";
Put_Token : constant String := "PUT";
Delete_Token : constant String := "DELETE";
Trace_Token : constant String := "TRACE";
Connect_Token : constant String := "CONNECT";
-- Sorted like in RFC 2616 Method definition
------------------------
-- HTTP header tokens --
------------------------
-- General header tokens RFC 2616
Cache_Control_Token : constant String := "Cache-Control";
Connection_Token : constant String := "Connection";
Date_Token : constant String := "Date";
Pragma_Token : constant String := "Pragma";
Trailer_Token : constant String := "Trailer";
Transfer_Encoding_Token : constant String := "Transfer-Encoding";
Upgrade_Token : constant String := "Upgrade";
Via_Token : constant String := "Via";
Warning_Token : constant String := "Warning";
-- Request header tokens RFC 2616
Accept_Token : constant String := "Accept";
Accept_Charset_Token : constant String := "Accept-Charset";
Accept_Encoding_Token : constant String := "Accept-Encoding";
Accept_Language_Token : constant String := "Accept-Language";
Authorization_Token : constant String := "Authorization";
Expect_Token : constant String := "Expect";
From_Token : constant String := "From";
Host_Token : constant String := "Host";
If_Match_Token : constant String := "If-Match";
If_Modified_Since_Token : constant String := "If-Modified-Since";
If_None_Match_Token : constant String := "If-None-Match";
If_Range_Token : constant String := "If-Range";
If_Unmodified_Since_Token : constant String := "If-Unmodified-Since";
Max_Forwards_Token : constant String := "Max-Forwards";
Proxy_Authorization_Token : constant String := "Proxy-Authorization";
Range_Token : constant String := "Range";
Referer_Token : constant String := "Referer";
TE_Token : constant String := "TE";
User_Agent_Token : constant String := "User-Agent";
-- Cross-Origin Resource Sharing request header tokens
Access_Control_Request_Headers_Token : constant String :=
"Access-Control-Request-Headers";
Access_Control_Request_Method_Token : constant String :=
"Access-Control-Request-Method";
Origin_Token : constant String := "Origin";
-- Response header tokens RFC 2616
Accept_Ranges_Token : constant String := "Accept-Ranges";
Age_Token : constant String := "Age";
ETag_Token : constant String := "ETag";
Location_Token : constant String := "Location";
Proxy_Authenticate_Token : constant String := "Proxy-Authenticate";
Retry_After_Token : constant String := "Retry-After";
Server_Token : constant String := "Server";
Vary_Token : constant String := "Vary";
WWW_Authenticate_Token : constant String := "WWW-Authenticate";
-- Cross-Origin Resource Sharing response header tokens
Access_Control_Allow_Credentials_Token : constant String :=
"Access-Control-Allow-Credentials";
Access_Control_Allow_Headers_Token : constant String :=
"Access-Control-Allow-Headers";
Access_Control_Allow_Methods_Token : constant String :=
"Access-Control-Allow-Methods";
Access_Control_Allow_Origin_Token : constant String :=
"Access-Control-Allow-Origin";
Access_Control_Expose_Headers_Token : constant String :=
"Access-Control-Expose-Headers";
Access_Control_Max_Age_Token : constant String :=
"Access-Control-Max-Age";
-- Entity header tokens RFC 2616
Allow_Token : constant String := "Allow";
Content_Encoding_Token : constant String := "Content-Encoding";
Content_Language_Token : constant String := "Content-Language";
Content_Length_Token : constant String := "Content-Length";
Content_Location_Token : constant String := "Content-Location";
Content_MD5_Token : constant String := "Content-MD5";
Content_Range_Token : constant String := "Content-Range";
Content_Type_Token : constant String := "Content-Type";
Expires_Token : constant String := "Expires";
Last_Modified_Token : constant String := "Last-Modified";
-- Cookie token RFC 2109
Cookie_Token : constant String := "Cookie";
Set_Cookie_Token : constant String := "Set-Cookie";
Comment_Token : constant String := "Comment";
Domain_Token : constant String := "Domain";
Max_Age_Token : constant String := "Max-Age";
Path_Token : constant String := "Path";
Secure_Token : constant String := "Secure";
HTTP_Only_Token : constant String := "HttpOnly";
-- Other tokens
Proxy_Connection_Token : constant String := "Proxy-Connection";
Content_Disposition_Token : constant String := "Content-Disposition";
SOAPAction_Token : constant String := "SOAPAction";
Content_Id_Token : constant String := "Content-ID";
Content_Transfer_Encoding_Token : constant String :=
"Content-Transfer-Encoding";
-- WebSockets tokens
Websocket_Token : constant String := "WebSocket";
Sec_WebSocket_Accept_Token : constant String := "Sec-WebSocket-Accept";
Sec_WebSocket_Protocol_Token : constant String := "Sec-WebSocket-Protocol";
Sec_WebSocket_Key_Token : constant String := "Sec-WebSocket-Key";
Sec_WebSocket_Key1_Token : constant String := "Sec-WebSocket-Key1";
Sec_WebSocket_Key2_Token : constant String := "Sec-WebSocket-Key2";
Sec_WebSocket_Version_Token : constant String := "Sec-WebSocket-Version";
Sec_WebSocket_Origin_Token : constant String := "Sec-WebSocket-Origin";
Sec_WebSocket_Location_Token : constant String := "Sec-WebSocket-Location";
Chat_Token : constant String := "chat";
S100_Continue : constant String := "100-continue";
-- Supported expect header value
-----------------
-- Status Code --
-----------------
type Status_Code is
(S100, S101, S102,
-- 1xx : Informational - Request received, continuing process
S200, S201, S202, S203, S204, S205, S206, S207,
-- 2xx : Success - The action was successfully received, understood and
-- accepted
S300, S301, S302, S303, S304, S305, S307,
-- 3xx : Redirection - Further action must be taken in order to
-- complete the request
S400, S401, S402, S403, S404, S405, S406, S407, S408, S409,
S410, S411, S412, S413, S414, S415, S416, S417, S422, S423, S424,
-- 4xx : Client Error - The request contains bad syntax or cannot be
-- fulfilled
S500, S501, S502, S503, S504, S505, S507
-- 5xx : Server Error - The server failed to fulfill an apparently
-- valid request
);
subtype Informational is Status_Code range S100 .. S102;
subtype Success is Status_Code range S200 .. S207;
subtype Redirection is Status_Code range S300 .. S307;
subtype Client_Error is Status_Code range S400 .. S424;
subtype Server_Error is Status_Code range S500 .. S507;
function Image (S : Status_Code) return String;
-- Returns Status_Code image. This value does not contain the leading S
function Reason_Phrase (S : Status_Code) return String;
-- Returns the reason phrase for the status code S, see [RFC 2616 - 6.1.1]
function With_Body (S : Status_Code) return Boolean;
-- Returns True if message with status can have a body
----------------------
-- Content encoding --
----------------------
type Content_Encoding is (Identity, GZip, Deflate);
-- Encoding mode for the response, Identity means that no encoding is
-- done, Gzip/Deflate to select the Gzip or Deflate encoding algorithm.
-------------------
-- Cache_Control --
-------------------
type Cache_Option is new String;
-- Cache_Option is a string and any specific option can be specified. We
-- define four options:
--
-- Unspecified : No cache option will used.
-- No_Cache : Ask browser and proxy to not cache data (no-cache,
-- max-age, and s-maxage are specified).
-- No_Store : Ask browser and proxy to not store any data. This can be
-- used to protect sensitive data.
-- Prevent_Cache : Equivalent to No_Store + No_Cache
Unspecified : constant Cache_Option;
No_Cache : constant Cache_Option;
No_Store : constant Cache_Option;
Prevent_Cache : constant Cache_Option;
type Cache_Kind is (Request, Response);
type Delta_Seconds is new Integer range -1 .. Integer'Last;
-- Represents a delta-seconds parameter for some Cache_Data fields like
-- max-age, max-stale (value -1 is used for Unset).
Unset : constant Delta_Seconds;
No_Max_Stale : constant Delta_Seconds;
Any_Max_Stale : constant Delta_Seconds;
type Private_Option is new Unbounded_String;
All_Private : constant Private_Option;
Private_Unset : constant Private_Option;
-- Cache_Data is a record that represents cache control information
type Cache_Data (CKind : Cache_Kind) is record
No_Cache : Boolean := False;
No_Store : Boolean := False;
No_Transform : Boolean := False;
Max_Age : Delta_Seconds := Unset;
case CKind is
when Request =>
Max_Stale : Delta_Seconds := Unset;
Min_Fresh : Delta_Seconds := Unset;
Only_If_Cached : Boolean := False;
when Response =>
S_Max_Age : Delta_Seconds := Unset;
Public : Boolean := False;
Private_Field : Private_Option := Private_Unset;
Must_Revalidate : Boolean := False;
Proxy_Revalidate : Boolean := False;
end case;
end record;
function To_Cache_Option (Data : Cache_Data) return Cache_Option;
-- Returns a cache control value for an HTTP request/response, fields are
-- described into RFC 2616 [14.9 Cache-Control].
function To_Cache_Data
(Kind : Cache_Kind; Value : Cache_Option) return Cache_Data;
-- Returns a Cache_Data record parsed out of Cache_Option
----------
-- ETag --
----------
type ETag_Value is new String;
function Create_ETag
(Name : String; Weak : Boolean := False) return ETag_Value;
-- Returns an ETag value (strong by default and Weak if specified). For a
-- discussion about ETag see RFC 2616 [3.11 Entity Tags] and [14.19 ETag].
-------------------------------
-- HTTP message constructors --
-------------------------------
function Accept_Encoding (Encoding : String) return String with Inline;
function Accept_Type (Mode : String) return String with Inline;
function Accept_Language (Mode : String) return String with Inline;
function Authorization (Mode, Password : String) return String with Inline;
function Connection (Mode : String) return String with Inline;
function Content_Length (Size : Stream_Element_Offset) return String
with Inline;
function Cookie (Value : String) return String with Inline;
function Content_Type (Format : String) return String with Inline;
function Content_Type
(Format : String; Boundary : String) return String with Inline;
function Cache_Control (Option : Cache_Option) return String with Inline;
function Cache_Control (Data : Cache_Data) return String with Inline;
function Content_Disposition
(Format, Name, Filename : String) return String with Inline;
-- Note that this is not part of HTTP/1.1 standard, it is there because
-- there is a lot of implementation around using it. This header is used
-- in multipart data.
function ETag (Value : ETag_Value) return String with Inline;
function Expires (Date : Calendar.Time) return String with Inline;
-- The date should not be more than a year in the future, see RFC 2616
-- [14.21 Expires].
function Host (Name : String) return String with Inline;
function Last_Modified (Date : Calendar.Time) return String with Inline;
function Location (URL : String) return String with Inline;
function Proxy_Authorization (Mode, Password : String) return String
with Inline;
function Proxy_Connection (Mode : String) return String with Inline;
function Data_Range (Value : String) return String with Inline;
function SOAPAction (URI : String) return String with Inline;
function Status_Line
(Code : Status_Code;
Reason_Phrase : String := "") return String with Inline;
function Transfer_Encoding (Encoding : String) return String with Inline;
function User_Agent (Name : String) return String with Inline;
function WWW_Authenticate (Realm : String) return String with Inline;
-- Basic authentication request
function WWW_Authenticate
(Realm, Nonce : String; Stale : Boolean) return String with Inline;
-- Digest authentication request
function Sec_WebSocket_Accept (Key : String) return String with Inline;
-----------------------
-- helper functions --
-----------------------
function To_HTTP_Date (Time : Calendar.Time) return String;
-- Returns an Ada time as a string using the HTTP normalized format.
-- Format is RFC 822, updated by RFC 1123.
function To_Time (HTTP_Date : String) return Calendar.Time;
-- Returns an Ada time from an HTTP one. This is To_HTTP_Date opposite
-- function.
private
-- implementation removed
end AWS.Messages;
13.23. AWS.MIME¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
package AWS.MIME is
-- Some content type constants. All of them will be defined into this
-- package and associated with the right extensions. It is possible to
-- add new MIME types with the routines below or by placing a file named
-- aws.mime into the startup directory.
--
-- A MIME type is written in two parts: type/format
----------
-- Text --
----------
Text_CSS : constant String := "text/css";
Text_Javascript : constant String := "text/javascript";
Text_HTML : constant String := "text/html";
Text_Plain : constant String := "text/plain";
Text_XML : constant String := "text/xml";
Text_X_SGML : constant String := "text/x-sgml";
-----------
-- Image --
-----------
Image_Gif : constant String := "image/gif";
Image_Jpeg : constant String := "image/jpeg";
Image_Png : constant String := "image/png";
Image_SVG : constant String := "image/svg+xml";
Image_Tiff : constant String := "image/tiff";
Image_Icon : constant String := "image/x-icon";
Image_X_Portable_Anymap : constant String := "image/x-portable-anymap";
Image_X_Portable_Bitmap : constant String := "image/x-portable-bitmap";
Image_X_Portable_Graymap : constant String := "image/x-portable-graymap";
Image_X_Portable_Pixmap : constant String := "image/x-portable-pixmap";
Image_X_RGB : constant String := "image/x-rgb";
Image_X_Xbitmap : constant String := "image/x-xbitmap";
Image_X_Xpixmap : constant String := "image/x-xpixmap";
Image_X_Xwindowdump : constant String := "image/x-xwindowdump";
-----------------
-- Application --
-----------------
Application_Postscript : constant String := "application/postscript";
Application_Pdf : constant String := "application/pdf";
Application_Zip : constant String := "application/zip";
Application_Octet_Stream : constant String := "application/octet-stream";
Application_Form_Data : constant String :=
"application/x-www-form-urlencoded";
Application_Mac_Binhex40 : constant String := "application/mac-binhex40";
Application_Msword : constant String := "application/msword";
Application_Powerpoint : constant String := "application/powerpoint";
Application_Rtf : constant String := "application/rtf";
Application_XML : constant String := "application/xml";
Application_JSON : constant String := "application/json";
Application_SOAP : constant String := "application/soap";
Application_X_Compress : constant String := "application/x-compress";
Application_X_GTar : constant String := "application/x-gtar";
Application_X_GZip : constant String := "application/x-gzip";
Application_X_Latex : constant String := "application/x-latex";
Application_X_Sh : constant String := "application/x-sh";
Application_X_Shar : constant String := "application/x-shar";
Application_X_Tar : constant String := "application/x-tar";
Application_X_Tcl : constant String := "application/x-tcl";
Application_X_Tex : constant String := "application/x-tex";
Application_X_Texinfo : constant String := "application/x-texinfo";
Application_X_Troff : constant String := "application/x-troff";
Application_X_Troff_Man : constant String := "application/x-troff-man";
-----------
-- Audio --
-----------
Audio_Basic : constant String := "audio/basic";
Audio_Mpeg : constant String := "audio/mpeg";
Audio_X_Wav : constant String := "audio/x-wav";
Audio_X_Pn_Realaudio : constant String := "audio/x-pn-realaudio";
Audio_X_Pn_Realaudio_Plugin : constant String :=
"audio/x-pn-realaudio-plugin";
Audio_X_Realaudio : constant String := "audio/x-realaudio";
-----------
-- Video --
-----------
Video_Mpeg : constant String := "video/mpeg";
Video_Quicktime : constant String := "video/quicktime";
Video_X_Msvideo : constant String := "video/x-msvideo";
---------------
-- Multipart --
---------------
Multipart_Form_Data : constant String := "multipart/form-data";
Multipart_Byteranges : constant String := "multipart/byteranges";
Multipart_Related : constant String := "multipart/related";
Multipart_X_Mixed_Replace : constant String :=
"multipart/x-mixed-replace";
-------------
-- Setting --
-------------
procedure Add_Extension (Ext : String; MIME_Type : String);
-- Add extension Ext (file extension without the dot, e.g. "txt") to the
-- set of MIME type extension handled by this API. Ext will be mapped to
-- the MIME_Type string.
procedure Add_Regexp (Filename : String; MIME_Type : String);
-- Add a specific rule to the MIME type table. Filename is a regular
-- expression and will be mapped to the MIME_Type string.
---------------
-- MIME Type --
---------------
function Content_Type
(Filename : String;
Default : String := Application_Octet_Stream) return String;
-- Returns the MIME Content Type based on filename's extension or if not
-- found the MIME Content type where Filename matches one of the specific
-- rules set by Add_Regexp (see below).
-- Returns Default if the file type is unknown (i.e. no extension and
-- no regular expression match filename).
function Extension (Content_Type : String) return String;
-- Returns the best guess of the extension to use for the Content Type.
-- Note that extensions added indirectly by Add_Regexp are not searched.
function Is_Text (MIME_Type : String) return Boolean;
-- Returns True if the MIME_Type is a text data
function Is_Audio (MIME_Type : String) return Boolean;
-- Returns True if the MIME_Type is an audio data
function Is_Image (MIME_Type : String) return Boolean;
-- Returns True if the MIME_Type is an image data
function Is_Video (MIME_Type : String) return Boolean;
-- Returns True if the MIME_Type is a video data
function Is_Application (MIME_Type : String) return Boolean;
-- Returns True if the MIME_Type is an application data
procedure Load (MIME_File : String);
-- Load MIME_File, record every MIME type. Note that the format of this
-- file follows the common standard format used by Apache mime.types.
end AWS.MIME;
13.24. AWS.Net¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2016, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- There is two implementations for this spec. One for standard sockets and
-- one for SSL socket. Note that the SSL implementation does support standard
-- socket too, this is controlled with the Security boolean on rountine
-- below. The corresponding implementation will be selected at build time.
with Ada.Exceptions;
with Ada.Finalization;
with Ada.Streams;
private with AWS.Utils;
private with Interfaces.C;
package AWS.Net is
use Ada;
use Ada.Exceptions;
use Ada.Streams;
Socket_Error : exception;
-- Raised by all routines below, a message will indicate the nature of
-- the error.
type Socket_Type is abstract new Finalization.Controlled with private;
type Socket_Access is access all Socket_Type'Class;
type Socket_Set is array (Positive range <>) of Socket_Access;
subtype FD_Type is Integer;
-- Represents an external socket file descriptor
No_Socket : constant := -1;
-- Represents closed socket file descriptor
type Event_Type is (Error, Input, Output);
-- Error - socket is in error state.
-- Input - socket ready for read.
-- Output - socket available for write.
type Event_Set is array (Event_Type) of Boolean;
-- Type for get result of events waiting
subtype Wait_Event_Type is Event_Type range Input .. Output;
type Wait_Event_Set is array (Wait_Event_Type) of Boolean;
-- Type for set events to wait, note that Error event would be waited
-- anyway.
type Family_Type is (Family_Inet, Family_Inet6, Family_Unspec);
type Shutmode_Type is (Shut_Read, Shut_Write, Shut_Read_Write);
Forever : constant Duration;
-- The longest delay possible on the implementation
----------------
-- Initialize --
----------------
function Socket (Security : Boolean) return Socket_Type'Class;
-- Create an uninitialized socket
function Socket
(Security : Boolean) return not null access Socket_Type'Class;
-- Create a dynamically allocated uninitialized socket
procedure Bind
(Socket : in out Socket_Type;
Port : Natural;
Host : String := "";
Reuse_Address : Boolean := False;
IPv6_Only : Boolean := False;
Family : Family_Type := Family_Unspec) is abstract;
-- Create the server socket and bind it on the given port.
-- Using 0 for the port will tell the OS to allocate a non-privileged
-- free port. The port can be later retrieved using Get_Port on the
-- bound socket.
-- IPv6_Only has meaning only for Family = Family_Inet6 and mean that only
-- IPv6 clients allowed to connect.
procedure Listen
(Socket : Socket_Type; Queue_Size : Positive := 5) is abstract;
-- Set the queue size of the socket
procedure Accept_Socket
(Socket : Socket_Type'Class; New_Socket : in out Socket_Type) is abstract;
-- Accept a connection on a socket. If it raises Socket_Error, all
-- resources used by new_Socket have been released.
-- There is not need to call Free or Shutdown.
type Socket_Constructor is not null access
function (Security : Boolean) return Socket_Type'Class;
procedure Connect
(Socket : in out Socket_Type;
Host : String;
Port : Positive;
Wait : Boolean := True;
Family : Family_Type := Family_Unspec) is abstract
with Pre'Class => Host'Length > 0;
-- Connect a socket on a given host/port. If Wait is True Connect will wait
-- for the connection to be established for timeout seconds, specified by
-- Set_Timeout routine. If Wait is False Connect will return immediately,
-- not waiting for the connection to be establised. It is possible to wait
-- for the Connection completion by calling Wait routine with Output set to
-- True in Events parameter.
procedure Socket_Pair (S1, S2 : out Socket_Type);
-- Create 2 sockets and connect them together
procedure Shutdown
(Socket : Socket_Type;
How : Shutmode_Type := Shut_Read_Write) is abstract;
-- Shutdown the read, write or both side of the socket.
-- If How is Both, close it. Does not raise Socket_Error if the socket is
-- not connected or already shutdown.
procedure Free (Socket : in out Socket_Access);
-- Release memory associated with the socket
--------
-- IO --
--------
procedure Send
(Socket : Socket_Type'Class; Data : Stream_Element_Array);
-- Send Data chunk to the socket
procedure Send
(Sockets : Socket_Set; Data : Stream_Element_Array);
-- Send Data to all sockets from the socket set. This call will ensure that
-- the data are sent in priority to client waiting for reading. That is,
-- slow connection for one sokcet should not delay the fast connections.
-- Yet, this routine will return only when the data is sent to all sockets.
procedure Send
(Socket : Socket_Type;
Data : Stream_Element_Array;
Last : out Stream_Element_Offset) is abstract;
-- Try to place data to Socket's output buffer. If all data cannot be
-- placed to the socket output buffer, Last will be lower than Data'Last,
-- if no data has been placed into the output buffer, Last is set to
-- Data'First - 1. If Data'First is equal to Stream_Element_Offset'First
-- then constraint error is raised to follow advice in AI95-227.
procedure Receive
(Socket : Socket_Type;
Data : out Stream_Element_Array;
Last : out Stream_Element_Offset) is abstract;
-- Read a chunk of data from the socket and set appropriate Last value.
-- This call always returns some data and will wait for incoming data only
-- if necessary.
function Receive
(Socket : Socket_Type'Class;
Max : Stream_Element_Count := 4096) return Stream_Element_Array;
-- Read a chunk of data from the socket and returns it. This call always
-- returns some data and will wait for incoming data only if necessary.
function Pending (Socket : Socket_Type) return Stream_Element_Count
is abstract;
-- Returns the number of bytes which are available inside socket
-- for immediate read.
function Output_Space (Socket : Socket_Type) return Stream_Element_Offset;
-- Returns the free space in output buffer in bytes. If OS could not
-- provide such information, routine returns -1.
function Output_Busy (Socket : Socket_Type) return Stream_Element_Offset;
-- How many bytes in the send queue. If OS could not provide such
-- information, routine returns -1.
------------
-- Others --
------------
function Get_FD (Socket : Socket_Type) return FD_Type is abstract;
-- Returns the file descriptor associated with the socket
function Peer_Addr (Socket : Socket_Type) return String is abstract;
-- Returns the peer name/address
function Peer_Port (Socket : Socket_Type) return Positive is abstract;
-- Returns the port of the peer socket
function Get_Addr (Socket : Socket_Type) return String is abstract;
-- Returns the name/address of the socket
function Get_Port (Socket : Socket_Type) return Positive is abstract;
-- Returns the port of the socket
function Is_Any_Address (Socket : Socket_Type) return Boolean;
-- Return true if the socket accepts connections on any of the hosts's
-- network addresses.
function Is_IPv6 (Socket : Socket_Type) return Boolean;
function Is_Listening (Socket : Socket_Type) return Boolean;
-- Returns true if the socket has been marked to accept connections with
-- listen.
function IPv6_Available return Boolean;
-- Returns True if IPv6 available in OS and in AWS socket implementation
function Host_Name return String;
-- Returns the running host name
procedure Set_Send_Buffer_Size
(Socket : Socket_Type; Size : Natural) is abstract;
-- Set the internal socket send buffer size.
-- Do not confuse with buffers for the AWS.Net.Buffered operations.
procedure Set_Receive_Buffer_Size
(Socket : Socket_Type; Size : Natural) is abstract;
-- Set the internal socket receive buffer size.
-- Do not confuse with buffers for the AWS.Net.Buffered operations.
function Get_Send_Buffer_Size (Socket : Socket_Type) return Natural
is abstract;
-- Returns the internal socket send buffer size.
-- Do not confuse with buffers for the AWS.Net.Buffered operations.
function Get_Receive_Buffer_Size (Socket : Socket_Type) return Natural
is abstract;
-- Returns the internal socket receive buffer size.
-- Do not confuse with buffers for the AWS.Net.Buffered operations.
function Cipher_Description (Socket : Socket_Type) return String;
-- Returns cipher description on SSL implementation or empty string on
-- plain socket.
procedure Set_Blocking_Mode
(Socket : in out Socket_Type; Blocking : Boolean);
pragma Obsolescent ("Use Set_Timeout instead");
-- Set the blocking mode for the socket
procedure Set_Timeout (Socket : in out Socket_Type; Timeout : Duration)
with Inline;
-- Sets the timeout for the socket read/write operations
procedure Set_No_Delay
(Socket : Socket_Type; Value : Boolean := True) is null;
-- Set/clear TCP_NODELAY option on socket
function Wait
(Socket : Socket_Type'Class;
Events : Wait_Event_Set) return Event_Set;
-- Waiting for Input/Output/Error events.
-- Waiting time is defined by Set_Timeout.
-- Empty event set in result mean that timeout occured.
function Check
(Socket : Socket_Type'Class;
Events : Wait_Event_Set) return Event_Set;
-- Check for Input/Output/Error events availability.
-- No wait for socket timeout.
function Poll
(Socket : Socket_Type'Class;
Events : Wait_Event_Set;
Timeout : Duration) return Event_Set;
-- Wait events on socket descriptor for specified Timeout
function Errno (Socket : Socket_Type) return Integer is abstract;
-- Returns and clears error state in socket
function Is_Timeout
(Socket : Socket_Type;
E : Exception_Occurrence) return Boolean;
-- Returns True if the message associated with the Exception_Occurence for
-- a Socket_Error is a timeout.
function Is_Timeout (E : Exception_Occurrence) return Boolean;
-- As above but without Socket parameter
function Is_Peer_Closed
(Socket : Socket_Type;
E : Exception_Occurrence) return Boolean;
-- Returns True if the message associated with the Exception_Occurence for
-- a Socket_Error is a "socket closed by peer".
--------------------
-- Socket FD sets --
--------------------
type FD_Set (Size : Natural) is abstract tagged private;
-- Abstract type for waiting of network events on group of sockets FD
type FD_Set_Access is access all FD_Set'Class;
function To_FD_Set
(Socket : Socket_Type;
Events : Wait_Event_Set;
Size : Positive := 1) return FD_Set'Class;
-- Create appropriate socket FD set and put Socket fd there
procedure Add
(FD_Set : in out FD_Set_Access;
FD : FD_Type;
Event : Wait_Event_Set);
-- Add FD to the end of FD_Set
procedure Free (FD_Set : in out FD_Set_Access) with Inline;
-- Deallocate the socket FD set
procedure Add
(FD_Set : in out Net.FD_Set;
FD : FD_Type;
Event : Wait_Event_Set) is abstract;
-- Add FD to the end of FD_Set
procedure Replace
(FD_Set : in out Net.FD_Set;
Index : Positive;
FD : FD_Type) is abstract
with Pre'Class => Index <= Length (FD_Set);
-- Replaces the socket FD in FD_Set
procedure Set_Mode
(FD_Set : in out Net.FD_Set;
Index : Positive;
Mode : Wait_Event_Set) is abstract
with Pre'Class => Index <= Length (FD_Set);
-- Sets the kind of network events to wait for
procedure Set_Event
(FD_Set : in out Net.FD_Set;
Index : Positive;
Event : Wait_Event_Type;
Value : Boolean) is abstract
with Pre'Class => Index <= Length (FD_Set);
function Copy
(FD_Set : not null access Net.FD_Set;
Size : Natural) return FD_Set_Access is abstract;
-- Allocates and copy the given FD_Set with different size
procedure Remove
(FD_Set : in out Net.FD_Set; Index : Positive) is abstract
with Pre'Class => Index <= Length (FD_Set);
-- Removes socket FD from Index position.
-- Last socket FD in FD_Set is placed at position Index.
function Length (FD_Set : Net.FD_Set) return Natural is abstract;
-- Returns number of socket FD elements in FD_Set
procedure Wait
(FD_Set : in out Net.FD_Set;
Timeout : Duration;
Count : out Natural) is abstract
with Post'Class => Count <= Length (FD_Set);
-- Wait for network events on the sockets FD set. Count value is the
-- number of socket FDs with non empty event set.
procedure Next
(FD_Set : Net.FD_Set; Index : in out Positive) is abstract
with
Pre'Class => Index <= Length (FD_Set) + 1,
Post'Class => Index <= Length (FD_Set) + 1;
-- Looking for an active (for which an event has been detected by routine
-- Wait above) socket FD starting from Index and return Index of the found
-- active socket FD. Use functions Status to retreive the kind of network
-- events for this socket.
function Status
(FD_Set : Net.FD_Set;
Index : Positive) return Event_Set is abstract
with Pre'Class => Index <= Length (FD_Set);
-- Returns events for the socket FD at position Index
procedure Free (Socket : in out Socket_Type) is null;
-- Release memory associated with the socket object. This default version
-- can be overriden to properly release the memory for the derived
-- implementation. The controlled Finalize routine is in charge of calling
-- Free. We could not have it in the private part because we could not make
-- AWS.Net.SSL.Free overriding this way.
function Localhost (IPv6 : Boolean) return String;
-- Returns "::1" if IPv6 is true or "127.0.0.1" otherwise
private
-- implementation removed
end AWS.Net;
13.25. AWS.Net.Buffered¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- All routines below are buffered both ways (input and output) for better
-- performances.
package AWS.Net.Buffered is
------------
-- Output --
------------
procedure Put (Socket : Socket_Type'Class; Item : String);
-- Write Item into Socket's buffer. Send the buffer to the socket if full
procedure Put_Line (Socket : Socket_Type'Class; Item : String);
-- Write Item & CRLF into Socket's buffer. Send the buffer to the socket
-- if full.
procedure New_Line (Socket : Socket_Type'Class) with Inline;
-- Write CRLF into Socket's buffer. Send the buffer to the socket if full
procedure Write
(Socket : Socket_Type'Class; Item : Stream_Element_Array);
-- Write Item into Socket's buffer. Send the buffer to the socket if full
procedure Flush (Socket : Socket_Type'Class);
-- Send the buffer to the socket
-----------
-- Input --
-----------
Data_Overflow : exception;
-- Raised from Get_Line and Read_Until routines when size of receiving data
-- exceeds the limit defined by Set_Input_Limit. It avoid unlimited dynamic
-- memory allocation inside of Get_Line and Read_Until when client trying
-- to attack the server by the very long lines in request. Moreover it
-- avoid stack overflow on very long data returned from Get_Line and
-- Read_Until.
procedure Set_Input_Limit (Limit : Positive) with Inline;
-- Set the input size limit for Get_Line and Read_Until routines
function Get_Input_Limit return Stream_Element_Offset with Inline;
-- Get the input size limit for Get_Line and Read_Until routines
procedure Read
(Socket : Socket_Type'Class; Data : out Stream_Element_Array) with Inline;
-- Returns Data array read from the socket
function Read
(Socket : Socket_Type'Class;
Max : Stream_Element_Count := 4096) return Stream_Element_Array
with Inline;
-- Returns an array of bytes read from the socket
procedure Read
(Socket : Socket_Type'Class;
Data : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- Read any available data from buffered socket.
-- Wait if no data available.
-- Same semantic with Net.Receive procedure.
function Get_Line (Socket : Socket_Type'Class) return String;
-- Returns a line read from Socket. A line is a set of character
-- terminated by CRLF.
function Get_Char (Socket : Socket_Type'Class) return Character with Inline;
-- Returns a single character read from socket
function Peek_Char (Socket : Socket_Type'Class) return Character
with Inline;
-- Returns next character that will be read from Socket. It does not
-- actually consume the character, this character will be returned by
-- the next read operation on the socket.
procedure Read_Buffer
(Socket : Socket_Type'Class;
Data : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- Returns data read from the internal socket's read buffer. No data are
-- read from the socket. This can be useful when switching to non buffered
-- mode.
function Read_Until
(Socket : Socket_Type'Class;
Delimiter : Stream_Element_Array;
Wait : Boolean := True) return Stream_Element_Array;
-- Read data on the Socket until the delimiter (including the delimiter).
-- If Wait is False the routine looking for the delimiter only in the
-- cache buffer, if delimiter not found in the cache buffer, empty array
-- is be returned.
-- If returned data is without delimiter at the end, it means that socket
-- is closed from peer or socket error occured and rest of data returned.
-- This routine could loose some data on timeout if does not meet delimiter
-- longer then Read buffer size.
function Read_Until
(Socket : Socket_Type'Class;
Delimiter : String;
Wait : Boolean := True) return String;
-- Same as above but returning a standard string
-------------
-- Control --
-------------
procedure Shutdown (Socket : Socket_Type'Class);
-- Shutdown and close the socket. Release all memory and resources
-- associated with it.
end AWS.Net.Buffered;
13.26. AWS.Net.Log¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2013, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This package handles the Net logging facility for AWS.
--
-- AWS calls the Write procedure which in turn calls the callback routine
-- provided by the user when starting the logging. This feature can help
-- greatly to debug an application.
--
-- This package is thread safe. There will never be two simultaneous calls
-- to the callback routine.
package AWS.Net.Log is
type Data_Direction is (Sent, Received);
-- The direction of the data, sent or received to/from the socket
type Event_Type is (Connect, Accept_Socket, Shutdown);
type Write_Callback is access procedure
(Direction : Data_Direction;
Socket : Socket_Type'Class;
Data : Stream_Element_Array;
Last : Stream_Element_Offset);
-- The callback procedure which is called for each incoming/outgoing data
type Event_Callback is access procedure
(Action : Event_Type; Socket : Socket_Type'Class);
-- The callback procedure which is called for every socket creation,
-- connect and accept.
type Error_Callback is access procedure
(Socket : Socket_Type'Class; Message : String);
-- The callback procedure which is called for every socket error
procedure Start
(Write : Write_Callback;
Event : Event_Callback := null;
Error : Error_Callback := null);
-- Activate the logging
function Is_Active return Boolean with Inline;
-- Returns True if Log is activated and False otherwise
function Is_Write_Active return Boolean with Inline;
-- Returns True if Write Log is activated and False otherwise
function Is_Event_Active return Boolean with Inline;
-- Returns True if Event Log is activated and False otherwise
procedure Write
(Direction : Data_Direction;
Socket : Socket_Type'Class;
Data : Stream_Element_Array;
Last : Stream_Element_Offset);
-- Write sent/received data indirectly through the callback routine,
-- if activated (i.e. Start routine above has been called). Otherwise this
-- call does nothing.
procedure Event (Action : Event_Type; Socket : Socket_Type'Class);
-- Call Event callback if activated (i.e. Start routine above has been
-- called). Otherwise this call does nothing.
procedure Error (Socket : Socket_Type'Class; Message : String);
-- Call Error callback if activated (i.e. Start routine above has been
-- called). Otherwise this call does nothing.
procedure Stop;
-- Stop logging activity
end AWS.Net.Log;
13.27. AWS.Net.Log.Callbacks¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Some ready to use write procedures
package AWS.Net.Log.Callbacks is
procedure Initialize
(Filename : String;
Callback : Write_Callback);
-- Initialize the logging, must be called before using the callbacks below
procedure Finalize;
-- Stop logging, close log file
procedure Text
(Direction : Data_Direction;
Socket : Socket_Type'Class;
Data : Stream_Element_Array;
Last : Stream_Element_Offset);
-- A text output, each chunk is output with an header and footer:
-- Data sent/received to/from socket <FD> (<size>/<buffer size>)
-- <data>
-- Total data sent: <nnn> received: <nnn>
procedure Binary
(Direction : Data_Direction;
Socket : Socket_Type'Class;
Data : Stream_Element_Array;
Last : Stream_Element_Offset);
-- A binary output, each chunk is output with an header and footer. The
-- data itself is written using a format close to the Emacs hexl-mode:
-- Data sent/received to/from socket <FD> (<size>/<buffer size>)
-- HH HH HH HH HH HH HH HH HH HH HH HH az.rt.mpl..q
-- Total data sent: <nnn> received: <nnn>
--
-- HH is the hex character number, if the character is not printable a dot
-- is written.
end AWS.Net.Log.Callbacks;
13.28. AWS.Net.SSL¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2018, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This is the SSL based implementation of the Net package. The implementation
-- should depend only on AWS.Net.Std and the SSL library. It is important to
-- not call directly a socket binding here to ease porting.
with Ada.Calendar;
with System;
with AWS.Net.Std;
with SSL.Thin;
package AWS.Net.SSL is
Socket_Error : exception renames Net.Socket_Error;
type Socket_Type is new Net.Std.Socket_Type with private;
type Session_Type is private;
-- To keep session data over plain socket reconnect
Null_Session : constant Session_Type;
Is_Supported : constant Boolean;
-- True if SSL supported in the current runtime
type Debug_Output_Procedure is access procedure (Text : String);
----------------
-- Initialize --
----------------
overriding procedure Accept_Socket
(Socket : Net.Socket_Type'Class; New_Socket : in out Socket_Type);
-- Accept a connection on a socket
overriding procedure Connect
(Socket : in out Socket_Type;
Host : String;
Port : Positive;
Wait : Boolean := True;
Family : Family_Type := Family_Unspec);
-- Connect a socket on a given host/port. If Wait is True Connect will wait
-- for the connection to be established for timeout seconds, specified by
-- Set_Timeout routine. If Wait is False Connect will return immediately,
-- not waiting for the connection to be establised and it does not make the
-- SSL handshake. It is possible to wait for the Connection completion by
-- calling Wait routine with Output set to True in Events parameter.
overriding procedure Socket_Pair (S1, S2 : out Socket_Type);
-- Create 2 sockets and connect them together
overriding procedure Shutdown
(Socket : Socket_Type; How : Shutmode_Type := Shut_Read_Write);
-- Shutdown the read, write or both side of the socket.
-- If How is Both, close it. Does not raise Socket_Error if the socket is
-- not connected or already shutdown.
--------
-- IO --
--------
overriding procedure Send
(Socket : Socket_Type;
Data : Stream_Element_Array;
Last : out Stream_Element_Offset);
overriding procedure Receive
(Socket : Socket_Type;
Data : out Stream_Element_Array;
Last : out Stream_Element_Offset)
with Inline;
overriding function Pending
(Socket : Socket_Type) return Stream_Element_Count;
-- Returns the number of bytes which are available inside socket
-- for immediate read.
--------------------
-- Initialization --
--------------------
type Method is
(TLS, TLS_Server, TLS_Client, -- Highest available TLS
TLSv1, TLSv1_Server, TLSv1_Client, -- TLS 1.0
TLSv1_1, TLSv1_1_Server, TLSv1_1_Client, -- TLS 1.1
TLSv1_2, TLSv1_2_Server, TLSv1_2_Client); -- TLS 1.2
SSLv23 : constant Method := TLS
with Obsolescent => "use TLS instead";
SSLv23_Server : constant Method := TLS_Server
with Obsolescent => "use TLS_Server instead";
SSLv23_Client : constant Method := TLS_Client
with Obsolescent => "use TLS_Client instead";
SSLv3 : constant Method := TLS
with Obsolescent => "use TLS instead";
SSLv3_Server : constant Method := TLS_Server
with Obsolescent => "use TLS_Server instead";
SSLv3_Client : constant Method := TLS_Client
with Obsolescent => "use TLS_Client instead";
type Config is private;
Null_Config : constant Config;
procedure Initialize
(Config : in out SSL.Config;
Certificate_Filename : String;
Security_Mode : Method := TLS;
Priorities : String := "";
Ticket_Support : Boolean := False;
Key_Filename : String := "";
Exchange_Certificate : Boolean := False;
Certificate_Required : Boolean := False;
Trusted_CA_Filename : String := "";
CRL_Filename : String := "";
Session_Cache_Size : Natural := 16#4000#);
-- Initialize the SSL layer into Config. Certificate_Filename must point
-- to a valid certificate. Security mode can be used to change the
-- security method used by AWS. Key_Filename must be specified if the key
-- is not in the same file as the certificate. The Config object can be
-- associated with all secure sockets sharing the same options. If
-- Exchange_Certificate is True the client will send its certificate to
-- the server, if False only the server will send its certificate.
procedure Add_Host_Certificate
(Config : SSL.Config;
Host : String;
Certificate_Filename : String;
Key_Filename : String := "");
-- Support for Server name indication (SNI). Client can ask for different
-- host names on the same IP address. This routines provide a way to have
-- different certificates for different server host names.
procedure Initialize_Default_Config
(Certificate_Filename : String;
Security_Mode : Method := TLS;
Priorities : String := "";
Ticket_Support : Boolean := False;
Key_Filename : String := "";
Exchange_Certificate : Boolean := False;
Certificate_Required : Boolean := False;
Trusted_CA_Filename : String := "";
CRL_Filename : String := "";
Session_Cache_Size : Natural := 16#4000#);
-- As above but for the default SSL configuration which is will be used
-- for any socket not setting explicitly an SSL config object. Not that
-- this routine can only be called once. Subsequent calls are no-op. To
-- be effective it must be called before any SSL socket is created.
procedure Release (Config : in out SSL.Config);
-- Release memory associated with the Config object
procedure Set_Config
(Socket : in out Socket_Type; Config : SSL.Config);
-- Set the SSL configuration object for the secure socket
function Get_Config (Socket : Socket_Type) return SSL.Config with Inline;
-- Get the SSL configuration object of the secure socket
function Secure_Client
(Socket : Net.Socket_Type'Class;
Config : SSL.Config := Null_Config;
Host : String := "") return Socket_Type;
-- Make client side SSL connection from plain socket.
-- SSL handshake does not performed. SSL handshake would be made
-- automatically on first Read/Write, or explicitly by the Do_Handshake
-- call. Do not free or close source socket after this call.
-- Host parameter is hostname to connect and used to send over SSL
-- connection to server if defined.
function Secure_Server
(Socket : Net.Socket_Type'Class;
Config : SSL.Config := Null_Config) return Socket_Type;
-- Make server side SSL connection from plain socket.
-- SSL handshake does not performed. SSL handshake would be made
-- automatically on first Read/Write, or explicitly by the Do_Handshake
-- call. Do not free or close source socket after this call.
procedure Do_Handshake (Socket : in out Socket_Type);
-- Wait for a SSL/TLS handshake to take place. You need to call this
-- routine if you have converted a standard socket to secure one and need
-- to get the peer certificate.
function Version (Build_Info : Boolean := False) return String;
-- Returns version information
procedure Clear_Session_Cache (Config : SSL.Config := Null_Config);
-- Remove all sessions from SSL session cache from the SSL context.
-- Null_Config mean default context.
procedure Set_Session_Cache_Size
(Size : Natural; Config : SSL.Config := Null_Config);
-- Set session cache size in the SSL context.
-- Null_Config mean default context.
function Session_Cache_Number
(Config : SSL.Config := Null_Config) return Natural;
-- Returns number of sessions currently in the cache.
-- Null_Config mean default context.
overriding function Cipher_Description (Socket : Socket_Type) return String;
procedure Ciphers (Cipher : not null access procedure (Name : String));
-- Calls callback Cipher for all available ciphers
procedure Generate_DH;
-- Regenerates Diffie-Hellman parameters.
-- The call could take a quite long time.
-- Diffie-Hellman parameters should be discarded and regenerated once a
-- week or once a month. Depends on the security requirements.
-- (gnutls/src/serv.c).
procedure Generate_RSA;
-- Regenerates RSA parameters.
-- The call could take some time.
-- RSA parameters should be discarded and regenerated once a day, once
-- every 500 transactions etc. Depends on the security requirements
-- (gnutls/src/serv.c).
procedure Abort_DH_Generation with Inline;
-- DH generation could be for a few minutes. If it is really necessary to
-- terminate process faster, this call should be used.
-- GNUTLS generates DH parameters much faster than OpenSSL, at least in
-- Linux x86_64 and does not support DH generation abort at least in
-- version 3.2.12.
procedure Start_Parameters_Generation
(DH : Boolean; Logging : access procedure (Text : String) := null)
with Inline;
-- Start SSL parameters regeneration in background.
-- DH is False mean only RSA parameters generated.
-- DH is True mean RSA and DH both parameters generated.
function Generated_Time_DH return Ada.Calendar.Time with Inline;
-- Returns date and time when the DH parameters was generated last time.
-- Need to decide when new regeneration would start.
function Generated_Time_RSA return Ada.Calendar.Time with Inline;
-- Returns date and time when the RSA parameters was generated last time.
-- Need to decide when new regeneration would start.
procedure Set_Debug
(Level : Natural; Output : Debug_Output_Procedure := null);
-- Set debug information printed level and output callback.
-- Null output callback mean output to Ada.Text_IO.Current_Error.
function Session_Id_Image (Session : Session_Type) return String;
-- Returns base64 encoded session id. Could be used to recognize resumed
-- session when it has the same Id.
function Session_Id_Image (Socket : Socket_Type) return String;
-- Returns base64 encoded session id of the socket
function Session_Data (Socket : Socket_Type) return Session_Type;
-- For the client side SSL socket returns session data to be used to
-- resume session after socket disconnected.
procedure Free (Session : in out Session_Type);
-- Free session data
procedure Set_Session_Data
(Socket : in out Socket_Type; Data : Session_Type);
-- For the client side SSL socket try to resume session from data taken
-- from previosly connected socket by Session_Data routine.
function Session_Reused (Socket : Socket_Type) return Boolean;
-- Returns True in case session was successfully reused after
-- Set_Session_Data and handshake.
type Private_Key is private;
Null_Private_Key : constant Private_Key;
type Hash_Method is (MD5, SHA1, SHA224, SHA256, SHA384, SHA512);
function Load (Filename : String) return Private_Key;
procedure Free (Key : in out Private_Key) with Inline;
function Signature
(Data : String;
Key : Private_Key;
Hash : Hash_Method) return Stream_Element_Array with Inline;
function Signature
(Data : Stream_Element_Array;
Key : Private_Key;
Hash : Hash_Method) return Stream_Element_Array with Inline;
private
-- implementation removed
end AWS.Net.SSL;
13.29. AWS.Net.SSL.Certificate¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Calendar;
private with Ada.Containers.Indefinite_Holders;
private with Ada.Strings.Unbounded;
private with AWS.Utils;
package AWS.Net.SSL.Certificate is
type Object is private;
Undefined : constant Object;
function Get (Socket : Socket_Type) return Object;
-- Returns the certificate used by the SSL
function Common_Name (Certificate : Object) return String with Inline;
-- Returns the certificate's common name
function Subject (Certificate : Object) return String with Inline;
-- Returns the certificate's subject
function Issuer (Certificate : Object) return String with Inline;
-- Returns the certificate's issuer
function Serial_Number (Certificate : Object) return String with Inline;
-- Returns the certificate's serial number
function DER (Certificate : Object) return Stream_Element_Array with Inline;
-- Returns all certificate's data in DER format
overriding function "=" (Left, Right : Object) return Boolean with Inline;
-- Compare 2 certificates
function Load (Filename : String) return Object;
-- Load certificate from file in PEM format
function Activation_Time (Certificate : Object) return Calendar.Time
with Inline;
-- Certificate validity starting date
function Expiration_Time (Certificate : Object) return Calendar.Time
with Inline;
-- Certificate validity ending date
function Verified (Certificate : Object) return Boolean with Inline;
-- Returns True if the certificate has already been verified, this is
-- mostly interresting when used from the Verify_Callback below. If this
-- routine returns True it means that the certificate has already been
-- properly checked. If checked the certificate can be trusted and the
-- Verify_Callback should return True also. If it is False it is up to
-- the application to check the certificate into the Verify_Callback and
-- returns the appropriate status.
function Status (Certificate : Object) return Long_Integer with Inline;
-- Returns the status for the certificate. This is to be used inside the
-- verify callback to know why the certificate has been rejected.
function Status_Message (Certificate : Object) return String;
-- Returns the error message for the current certificate status (as
-- returned by Status above).
--
-- Client verification support
--
type Verify_Callback is
access function (Cert : SSL.Certificate.Object) return Boolean;
-- Client certificate verification callback, must return True if Cert can
-- be accepted or False otherwise. Such callback should generally return
-- the value returned by Verified above.
procedure Set_Verify_Callback
(Config : in out SSL.Config; Callback : Verify_Callback);
-- Register the callback to use to verify client's certificates
type Password_Callback is
access function (Certificate_Filename : String) return String;
-- Callback to get password for signed server's keys. An empty string
-- must be returned if the password is unknown or the certificate isn't
-- signed.
procedure Set_Password_Callback (Callback : Password_Callback);
-- Set the password callback
function Get_Password (Certificate_Filename : String) return String;
-- Request a password for the giver certificate. The default
-- implementation just returns an empty string.
private
-- implementation removed
end AWS.Net.SSL.Certificate;
13.30. AWS.Net.WebSocket¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2012-2019, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This implements the WebSocket protocol as defined in RFC-6455
with Ada.Strings.Unbounded;
with AWS.Status;
private with Ada.Calendar;
private with Ada.Containers.Doubly_Linked_Lists;
private with AWS.Client;
private with Interfaces;
package AWS.Net.WebSocket is
use Ada.Strings.Unbounded;
type Object is new Net.Socket_Type with private;
type Object_Class is access all Object'Class;
No_Object : constant Object'Class;
type Kind_Type
is (Unknown, Connection_Open, Text, Binary, Ping, Pong, Connection_Close);
-- Data Frame Kind
type Error_Type is
(Normal_Closure,
Going_Away,
Protocol_Error,
Unsupported_Data,
No_Status_Received,
Abnormal_Closure,
Invalid_Frame_Payload_Data,
Policy_Violation,
Message_Too_Big,
Mandatory_Extension,
Internal_Server_Error,
TLS_Handshake,
Cannot_Resolve_Error,
User_01, -- User's defined error code
User_02,
User_03,
User_04,
User_05);
--
-- The following three methods are the one to override or redefine. In fact
-- the default Send implementation should be ok for most usages.
--
function Create
(Socket : Socket_Access;
Request : AWS.Status.Data) return Object'Class
with Pre => Socket /= null;
-- Create a new instance of the WebSocket, this is used by AWS internal
-- server to create a default WebSocket if no other constructor are
-- provided. It is also needed when deriving from WebSocket.
--
-- This function must be registered via AWS.Net.WebSocket.Registry.Register
procedure On_Message (Socket : in out Object; Message : String) is null;
-- Default implementation does nothing, it needs to be overriden by the
-- end-user. This is the callback that will get activated for every server
-- incoming data. It is also important to keep in mind that the thread
-- handling this WebSocket won't be released until the procedure returns.
-- So the code inside this routine should be small and most importantly not
-- wait for an event to occur otherwise other requests won't be served.
procedure On_Message (Socket : in out Object; Message : Unbounded_String);
-- Same a above but takes an Unbounded_String. This is supposed to be
-- overriden when handling large messages otherwise a stack-overflow could
-- be raised. The default implementation of this procedure to to call the
-- On_Message above with a string.
--
-- So either this version is overriden to handle the incoming messages or
-- the one above if the messages are known to be small.
procedure On_Open (Socket : in out Object; Message : String) is null;
-- As above but activated when a WebSocket is opened
procedure On_Close (Socket : in out Object; Message : String) is null;
-- As above but activated when a WebSocket is closed
procedure On_Error (Socket : in out Object; Message : String) is null;
-- As above but activated when a WebSocket error is detected
procedure Send
(Socket : in out Object;
Message : String;
Is_Binary : Boolean := False);
-- This default implementation just send a message to the client. The
-- message is sent in a single chunk (not fragmented).
procedure Send
(Socket : in out Object;
Message : Unbounded_String;
Is_Binary : Boolean := False);
-- Same as above but can be used for large messages. The message is
-- possibly sent fragmented.
procedure Send
(Socket : in out Object;
Message : Stream_Element_Array;
Is_Binary : Boolean := True);
-- As above but default is a binary message
procedure Close
(Socket : in out Object;
Message : String;
Error : Error_Type := Normal_Closure);
-- Send a close frame to the WebSocket
--
-- Client side
--
procedure Connect
(Socket : in out Object'Class;
URI : String);
-- Connect to a remote server using websockets.
-- Socket can then be used to Send messages to the server. It will
-- also receive data from the server, via the On_Message, when you call
-- Poll
function Poll
(Socket : in out Object'Class;
Timeout : Duration) return Boolean;
-- Wait for up to Timeout seconds for some message.
--
-- In the websockets protocol, a message can be split (by the server)
-- onto several frames, so that for instance the server doesn't have to
-- store the whole message in its memory.
-- The size of those frames, however, is not limited, and they will
-- therefore possibly be split into several chunks by the transport
-- layer.
--
-- These function waits until it either receives a close or an error, or
-- the beginning of a message frame. In the latter case, the function
-- will then block until it has receives all chunks of that frame, which
-- might take longer than Timeout.
--
-- The function will return early if it doesn't receive the beginning
-- of a frame within Timeout seconds.
--
-- When a full frame has been received, it will be sent to the
-- Socket.On_Message primitive operation. Remember this might not be the
-- whole message however, and you should check Socket.End_Of_Message to
-- check.
--
-- Return True if a message was processed, False if nothing happened during
-- Timeout.
--
-- Simple accessors to WebSocket state
--
function Kind (Socket : Object) return Kind_Type;
-- Returns the message kind of the current read data
function Protocol_Version (Socket : Object) return Natural;
-- Returns the version of the protocol for this WebSocket
function URI (Socket : Object) return String;
-- Returns the URI for the WebSocket
function Origin (Socket : Object) return String;
-- Returns the Origin of the WebSocket. That is the value of the Origin
-- header of the client which has opened the socket.
function Request (Socket : Object) return AWS.Status.Data;
-- Returns Request of the WebSocket. That is the HTTP-request
-- of the client which has opened the socket.
function Error (Socket : Object) return Error_Type;
-- Returns the current error type
function End_Of_Message (Socket : Object) return Boolean;
-- Returns True if we have read a whole message
--
-- Socket's methods that must be overriden
--
overriding procedure Shutdown
(Socket : Object;
How : Shutmode_Type := Shut_Read_Write);
-- Shutdown the socket
overriding function Get_FD (Socket : Object) return FD_Type;
-- Returns the file descriptor associated with the socket
overriding function Peer_Addr (Socket : Object) return String;
-- Returns the peer name/address
overriding function Peer_Port (Socket : Object) return Positive;
-- Returns the port of the peer socket
overriding function Get_Addr (Socket : Object) return String;
-- Returns the name/address of the socket
overriding function Get_Port (Socket : Object) return Positive;
-- Returns the port of the socket
overriding function Errno (Socket : Object) return Integer;
-- Returns and clears error state in socket
overriding function Get_Send_Buffer_Size (Socket : Object) return Natural;
-- Returns the internal socket send buffer size.
-- Do not confuse with buffers for the AWS.Net.Buffered operations.
overriding function Get_Receive_Buffer_Size
(Socket : Object) return Natural;
-- Returns the internal socket receive buffer size.
-- Do not confuse with buffers for the AWS.Net.Buffered operations.
--
-- Socket reference
--
type UID is range 0 .. 2**31;
No_UID : constant UID;
-- Not an UID, this is a WebSocket not yet initialized
function Get_UID (Socket : Object) return UID;
-- Returns a unique id for the given socket. The uniqueness for this socket
-- is guaranteed during the lifetime of the application.
private
-- implementation removed
end AWS.Net.WebSocket;
13.31. AWS.Net.WebSocket.Registry¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2012-2019, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This package is used to build and register the active WebSockets. Some
-- services to send or broadcast messages are also provided.
with AWS.Status;
private with GNAT.Regexp;
package AWS.Net.WebSocket.Registry is
type Factory is not null access function
(Socket : Socket_Access;
Request : AWS.Status.Data) return Object'Class;
-- Creating and Registering WebSockets
function Constructor (URI : String) return Registry.Factory
with Pre => URI'Length > 0;
-- Get the WebObject's constructor for a specific URI
procedure Register (URI : String; Factory : Registry.Factory)
with Pre => URI'Length > 0;
-- Register a WebObject's constructor for a specific URI
procedure Register_Pattern
(Pattern : String;
Factory : Registry.Factory)
with Pre => Pattern'Length > 0;
-- Register a WebObject's constructor for a specific URI and pattern
-- Sending messages
type Recipient is private;
No_Recipient : constant Recipient;
function Create (URI : String; Origin : String := "") return Recipient
with Pre => URI'Length > 0,
Post => Create'Result /= No_Recipient;
-- A recipient with only an URI is called a broadcast as it designate all
-- registered WebSocket for this specific URI. If Origin is specified then
-- it designates a single client.
--
-- Note that both URI and Origin can be regular expressions.
function Create (Id : UID) return Recipient
with Pre => Id /= No_UID,
Post => Create'Result /= No_Recipient;
-- A recipient for a specific WebSocket
type Action_Kind is (None, Close);
procedure Send
(To : Recipient;
Message : String;
Except_Peer : String := "";
Timeout : Duration := Forever;
Asynchronous : Boolean := False;
Error : access procedure (Socket : Object'Class;
Action : out Action_Kind) := null)
with Pre => To /= No_Recipient
and then (if Asynchronous then Error = null);
-- Send a message to the WebSocket designated by Origin and URI. Do not
-- send this message to the peer whose address is given by Except_Peer.
-- Except_Peer must be the address as reported by AWS.Net.Peer_Addr. It is
-- often needed to send a message to all registered sockets except the one
-- which has sent the message triggering a response.
procedure Send
(To : Recipient;
Message : Unbounded_String;
Except_Peer : String := "";
Timeout : Duration := Forever;
Asynchronous : Boolean := False;
Error : access procedure (Socket : Object'Class;
Action : out Action_Kind) := null)
with Pre => To /= No_Recipient
and then (if Asynchronous then Error = null);
-- As above but with an Unbounded_String
procedure Send
(To : Recipient;
Message : String;
Request : AWS.Status.Data;
Timeout : Duration := Forever;
Asynchronous : Boolean := False;
Error : access procedure (Socket : Object'Class;
Action : out Action_Kind) := null)
with Pre => To /= No_Recipient
and then (if Asynchronous then Error = null);
-- As above but filter out the client having set the given request
procedure Send
(To : Recipient;
Message : Unbounded_String;
Request : AWS.Status.Data;
Timeout : Duration := Forever;
Asynchronous : Boolean := False;
Error : access procedure (Socket : Object'Class;
Action : out Action_Kind) := null)
with Pre => To /= No_Recipient
and then (if Asynchronous then Error = null);
-- As above but with an Unbounded_String
procedure Close
(To : Recipient;
Message : String;
Except_Peer : String := "";
Timeout : Duration := Forever;
Error : Error_Type := Normal_Closure)
with Pre => To /= No_Recipient;
-- Close connections
-- Targetting a single WebSocket, these routines are equivalent to the
-- Net.WebSocket ones but are thread-safe. That is, they can be mixed
-- with other WebSocket activity to and from the clients.
procedure Send
(Socket : in out Object'Class;
Message : String;
Is_Binary : Boolean := False;
Timeout : Duration := Forever;
Asynchronous : Boolean := False);
-- This default implementation just send a message to the client. The
-- message is sent in a single chunk (not fragmented).
procedure Send
(Socket : in out Object'Class;
Message : Unbounded_String;
Is_Binary : Boolean := False;
Timeout : Duration := Forever;
Asynchronous : Boolean := False);
-- Same as above but can be used for large messages. The message is
-- possibly sent fragmented.
procedure Send
(Socket : in out Object'Class;
Message : Stream_Element_Array;
Is_Binary : Boolean := True;
Timeout : Duration := Forever;
Asynchronous : Boolean := False);
-- As above but for a Stream_Element_Array
procedure Close
(Socket : in out Object'Class;
Message : String;
Timeout : Duration := Forever;
Error : Error_Type := Normal_Closure);
function Is_Registered (Id : UID) return Boolean;
-- Returns True if the WebSocket Id is registered and False otherwise
private
-- implementation removed
end AWS.Net.WebSocket.Registry;
13.32. AWS.Net.WebSocket.Registry.Control¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- This package is used to start/stop the WebSockets services
package AWS.Net.WebSocket.Registry.Control is
procedure Start;
-- Start the WebSockets servers
procedure Shutdown;
-- Shutdown the WebSockets servers
end AWS.Net.WebSocket.Registry.Control;
13.33. AWS.Parameters¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
with AWS.Containers.Tables;
with AWS.Resources.Streams.Memory;
package AWS.Parameters is
type List is new AWS.Containers.Tables.Table_Type with private;
subtype VString_Array is AWS.Containers.Tables.VString_Array;
function URI_Format
(Parameter_List : List; Limit : Positive := Positive'Last) return String;
-- Returns the list of parameters in the URI format. This can be added
-- after the resource to form the complete URI. The format is:
-- "?name1=value1&name2=value2..."
-- If there is no parameter in the list, the empty string is returned.
-- Limit is maximum size of the output line, parameters name=value will be
-- returned unbroken in case of limit applied.
procedure Add
(Parameter_List : in out List; Name, Value : String; Decode : Boolean);
procedure Add
(Parameter_List : in out List;
Name, Value : Unbounded_String;
Decode : Boolean);
-- URL decode and add Name=Value pair into parameters
procedure Add (Parameter_List : in out List; Parameters : String);
-- Set parameters for the current request. The Parameters string has the
-- form "name1=value1&name2=value2...". The paramaters are added to the
-- list. The parameters can start with a '?' (standard Web character
-- separator) which is just ignored.
procedure Add
(Parameter_List : in out List;
Parameters : in out Resources.Streams.Memory.Stream_Type'Class);
-- Same as above, but use different parameters source. Used to reduce
-- stack usage on big POST requests. This is the routine used by AWS for
-- parsing the POST parameters. This routine also control the maximum
-- number of parameter parsed as set by the corresponding configuration
-- option.
procedure Update
(Parameter_List : in out List; Name, Value : String; Decode : Boolean);
procedure Update
(Parameter_List : in out List;
Name, Value : Unbounded_String;
Decode : Boolean);
Too_Long_Parameter : exception;
-- Raised if the Add routine detects a too long parameter line when reading
-- parameters from Memory_Stream.
Too_Many_Parameters : exception;
-- Raised when the maximum number of parameters has been reached
-- See AWS.Containers.Tables for inherited routines
private
-- implementation removed
end AWS.Parameters;
13.34. AWS.POP¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with Ada.Finalization;
with Ada.Strings.Unbounded;
with AWS.Headers;
with AWS.Net.Std;
with AWS.Resources.Streams;
with AWS.Utils;
package AWS.POP is
use Ada.Strings.Unbounded;
POP_Error : exception;
-- Raised by all routines when an error has been detected
-------------
-- Mailbox --
-------------
Default_POP_Port : constant := 110;
type Mailbox is private;
type Authenticate_Mode is (Clear_Text, APOP);
function Initialize
(Server_Name : String;
User : String;
Password : String;
Authenticate : Authenticate_Mode := Clear_Text;
Port : Positive := Default_POP_Port) return Mailbox;
-- Connect on the given Port to Server_Name and open User's Mailbox. This
-- mailbox object will be used to retrieve messages.
procedure Close (Mailbox : POP.Mailbox);
-- Close mailbox
function User_Name (Mailbox : POP.Mailbox) return String;
-- Returns User's name for this mailbox
function Message_Count (Mailbox : POP.Mailbox) return Natural;
-- Returns the number of messages in the user's mailbox
function Size (Mailbox : POP.Mailbox) return Natural;
-- Returns the total size in bytes of the user's mailbox
-------------
-- Message --
-------------
type Message is tagged private;
function Get
(Mailbox : POP.Mailbox;
N : Positive;
Remove : Boolean := False) return Message;
-- Retrieve Nth message from the mailbox, let the message on the mailbox
-- if Remove is False.
procedure Delete
(Mailbox : POP.Mailbox;
N : Positive);
-- Detele message number N from the mailbox
function Get_Header
(Mailbox : POP.Mailbox;
N : Positive) return Message;
-- Retrieve headers for the Nth message from the mailbox, let the message
-- on the mailbox. This is useful to build a quick summary of the mailbox.
generic
with procedure Action
(Message : POP.Message;
Index : Positive;
Quit : in out Boolean);
procedure For_Every_Message
(Mailbox : POP.Mailbox;
Remove : Boolean := False);
-- Calls Action for each message read on the mailbox, delete the message
-- from the mailbox if Remove is True. Set Quit to True to stop the
-- iterator. Index is the mailbox's message index.
generic
with procedure Action
(Message : POP.Message;
Index : Positive;
Quit : in out Boolean);
procedure For_Every_Message_Header (Mailbox : POP.Mailbox);
-- Calls Action for each message read on the mailbox. Only the headers are
-- read from the mailbox. Set Quit to True to stop the iterator. Index is
-- the mailbox's message index.
function Size (Message : POP.Message) return Natural;
-- Returns the message size in bytes
function Content (Message : POP.Message) return Unbounded_String;
-- Returns message's content as an Unbounded_String. Each line are
-- separated by CR+LF characters.
function From (Message : POP.Message) return String;
-- Returns From header value
function To (Message : POP.Message; N : Natural := 0) return String;
-- Returns the To header value. If N = 0 returns all recipients separated
-- by a coma otherwise it returns the Nth To recipient.
function To_Count (Message : POP.Message) return Natural;
-- Returns the number of To recipient for Message. returns 0 if there is
-- no To for this message.
function CC (Message : POP.Message; N : Natural := 0) return String;
-- Retruns the CC header value. If N = 0 returns all recipients separated
-- by a coma otherwise it returns the Nth CC recipient.
function CC_Count (Message : POP.Message) return Natural;
-- Returns the number of CC recipient for Message. Returns 0 if there is
-- no CC for this message.
function Subject (Message : POP.Message) return String;
-- Returns Subject header value
function Date (Message : POP.Message) return String;
-- Returns Date header value
function Header
(Message : POP.Message;
Header : String) return String;
-- Returns header value for header named Header, returns the empty string
-- if such header does not exist.
----------------
-- Attachment --
----------------
type Attachment is private;
function Attachment_Count (Message : POP.Message) return Natural;
-- Returns the number of Attachments into Message
function Get
(Message : POP.Message'Class;
Index : Positive) return Attachment;
-- Returns the Nth Attachment for Message, Raises Constraint_Error if
-- there is not such attachment.
generic
with procedure Action
(Attachment : POP.Attachment;
Index : Positive;
Quit : in out Boolean);
procedure For_Every_Attachment (Message : POP.Message);
-- Calls action for every Attachment in Message. Stop iterator if Quit is
-- set to True, Quit is set to False by default.
function Content
(Attachment : POP.Attachment)
return AWS.Resources.Streams.Stream_Access;
-- Returns Attachment's content as a memory stream. Note that the stream
-- has already been decoded. Most attachments are MIME Base64 encoded.
function Content (Attachment : POP.Attachment) return Unbounded_String;
-- Returns Attachment's content as an Unbounded_String. This routine must
-- only be used for non file attachments. Raises Constraint_Error if
-- called for a file attachment.
function Filename (Attachment : POP.Attachment) return String;
-- Returns the Attachment filename or the empty string if it is not a file
-- but an embedded message.
function Is_File (Attachment : POP.Attachment) return Boolean;
-- Returns True if Attachment is a file
procedure Write (Attachment : POP.Attachment; Directory : String);
-- Writes Attachment's file content into Directory. This must only be used
-- for a file attachment.
private
-- implementation removed
end AWS.POP;
13.35. AWS.Resources¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with Ada.Calendar;
with Ada.Streams;
with AWS.Utils;
private with Ada.Unchecked_Deallocation;
package AWS.Resources is
use Ada.Streams;
Resource_Error : exception;
type File_Type is limited private;
type File_Instance is (None, Plain, GZip, Both);
-- None : No instance of this file present.
-- Plain : A non-compressed version of this file exists.
-- GZip : A gzip encoded version of this file exists.
-- Both : Both versions of this file exists.
function "or" (I1, I2 : File_Instance) return File_Instance;
-- Returns the union of I1 and I2
subtype Content_Length_Type is Stream_Element_Offset;
Undefined_Length : constant Content_Length_Type;
-- Undefined length could be used when we do not know the message stream
-- length at the start of transfer. The end of message could be determined
-- by the chunked transfer-encoding in the HTTP/1.1, or by the closing
-- connection in the HTTP/1.0.
procedure Open
(File : out File_Type;
Name : String;
Form : String := "");
-- Open file in mode In_File. Only reading from the file is supported.
-- This procedure open the in-memory (embedded) file if present, otherwise
-- the file on disk is opened. Note that if Name file is not found, it
-- checks for Name & ".gz" and unzipped the file content in this case.
procedure Open
(File : out File_Type;
Name : String;
Form : String := "";
GZip : in out Boolean);
-- Open file in mode In_File. Only reading from the file is supported.
-- This procedure open the in-memory (embedded) file if present, otherwise
-- the file on disk is opened. If GZip parameter is False this call is
-- equivalent to the Open routine above. If GZip is True this routine will
-- first check for the compressed version of the resource (Name & ".gz"),
-- if found GZip output value will remain True. If GZip value is True and
-- the compressed version of the resource does not exist it looks for
-- non-compressed version and set GZip value to False.
procedure Reset (Resource : in out File_Type);
-- Reset the file, reading will restart at the beginning
procedure Set_Index
(Resource : in out File_Type;
To : Stream_Element_Offset);
-- Set the position in the stream, next Read will start at the position
-- whose index is To. If To is outside the content the index is set to
-- Last + 1 to ensure that next End_Of_File will return True.
procedure Close (Resource : in out File_Type);
-- Close the file
procedure Read
(Resource : in out File_Type;
Buffer : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- Returns a set of bytes from the file
procedure Get_Line
(Resource : in out File_Type;
Buffer : out String;
Last : out Natural);
-- Returns a line from the file. A line is a set of character terminated
-- by ASCII.LF (UNIX style EOL) or ASCII.CR+ASCII.LF (DOS style EOL).
function End_Of_File (Resource : File_Type) return Boolean;
-- Returns true if there is no more data to read
function LF_Terminated (Resource : File_Type) return Boolean;
-- Returns True if last line returned by Get_Line was terminated with a LF
-- or CR+LF on DOS based systems.
function Size (Resource : File_Type) return Content_Length_Type;
-- Returns the size (in bytes) of the resource. If the size of the
-- resource is not defined, the routine Size returns Undefined_Length
-- value.
function Exist (Name : String) return File_Instance;
-- Return GZip if only file Name & ".gz" exists.
-- Return Plain if only file Name exists.
-- Return Both if both file Name and Name & ".gz" exists.
-- Return None if files neither Name nor Name & ".gz" exist.
function Is_Regular_File (Name : String) return Boolean;
-- Returns True if Filename is a regular file and is readable. Checks
-- first for in memory file then for disk file.
function File_Size (Name : String) return Utils.File_Size_Type;
-- Returns Filename's size in bytes. Checks first for in memory file
-- then for disk file.
function File_Timestamp (Name : String) return Ada.Calendar.Time;
-- Get the time for last modification to a file in UTC/GMT. Checks first
-- for in memory file then for disk file.
private
-- implementation removed
end AWS.Resources;
13.36. AWS.Resources.Embedded¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2013, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with AWS.Resources.Streams.Memory;
package AWS.Resources.Embedded is
use Ada;
Resource_Error : exception renames Resources.Resource_Error;
subtype Buffer_Access is Streams.Memory.Buffer_Access;
procedure Open
(File : out File_Type;
Name : String;
Form : String := "";
GZip : in out Boolean);
-- Open resource from registered data
procedure Create
(File : out File_Type;
Buffer : Buffer_Access);
-- Create the resource directly from memory data
function Exist (Name : String) return File_Instance;
-- Return GZip if only file Name & ".gz" exists.
-- Return Plain if only file Name exists.
-- Return Both if both file Name and Name & ".gz" exists.
-- Return None if files neither Name nor Name & ".gz" exist.
function Is_Regular_File (Name : String) return Boolean with Inline;
-- Returns True if file named Name has been registered (i.e. it is an
-- in-memory file).
function File_Size (Name : String) return Utils.File_Size_Type;
function File_Timestamp (Name : String) return Ada.Calendar.Time;
procedure Register
(Name : String;
Content : Buffer_Access;
File_Time : Calendar.Time);
-- Register a new file named Name into the embedded resources. The file
-- content is pointed to by Content, the File_Time must be the last
-- modification time stamp for the file. If Name ends with ".gz" the
-- embedded resource registered as compressed. If a file is already
-- registered for this name, Content replace the previous one.
end AWS.Resources.Embedded;
13.37. AWS.Resources.Files¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with AWS.Utils;
package AWS.Resources.Files is
Resource_Error : exception renames Resources.Resource_Error;
procedure Open
(File : out File_Type;
Name : String;
Form : String := "";
GZip : in out Boolean);
procedure Open
(File : out File_Type;
Name : String;
Form : String := "");
function Exist (Name : String) return File_Instance;
-- Return GZip if only file Name & ".gz" exists.
-- Return Plain if only file Name exists.
-- Return Both if both file Name and Name & ".gz" exists.
-- Return None if files neither Name nor Name & ".gz" exist.
function Is_Regular_File (Name : String) return Boolean;
function File_Size (Name : String) return Utils.File_Size_Type;
function File_Timestamp (Name : String) return Ada.Calendar.Time;
end AWS.Resources.Files;
13.38. AWS.Resources.Streams¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
package AWS.Resources.Streams is
type Stream_Type is abstract tagged limited private;
type Stream_Access is access all Stream_Type'Class;
function End_Of_File (Resource : Stream_Type) return Boolean is abstract;
procedure Read
(Resource : in out Stream_Type;
Buffer : out Stream_Element_Array;
Last : out Stream_Element_Offset) is abstract;
procedure Reset (Resource : in out Stream_Type) is abstract;
procedure Set_Index
(Resource : in out Stream_Type;
To : Stream_Element_Offset) is abstract;
-- Set the position in the stream, next Read will start at the position
-- whose index is To. If To is outside the content the index is set to
-- Last + 1 to ensure that next End_Of_File will return True.
procedure Close (Resource : in out Stream_Type) is abstract;
function Size (Resource : Stream_Type) return Stream_Element_Offset;
-- This default implementation returns Undefined_Length. If the derived
-- stream implementation knows about the size (in bytes) of the stream
-- this routine should be redefined.
function Name (Resource : Stream_Type) return String;
-- This default implementation returns the empty string. It is must be
-- overwritten by file based stream to provide the proper filename
-- associated with the stream.
procedure Create
(Resource : out File_Type;
Stream : Stream_Access) with Inline;
-- Create a resource file from user defined stream
private
-- implementation removed
end AWS.Resources.Streams;
13.39. AWS.Resources.Streams.Disk¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- An ready-to-use implementation of the stream API where the stream content
-- is read from an on-disk file.
private with Ada.Strings.Unbounded;
private with Ada.Streams.Stream_IO;
package AWS.Resources.Streams.Disk is
type Stream_Type is new Streams.Stream_Type with private;
procedure Open
(File : out Stream_Type;
Name : String;
Form : String := "shared=no");
overriding function End_Of_File (Resource : Stream_Type) return Boolean;
overriding procedure Read
(Resource : in out Stream_Type;
Buffer : out Stream_Element_Array;
Last : out Stream_Element_Offset);
overriding function Size
(Resource : Stream_Type) return Stream_Element_Offset;
overriding function Name (Resource : Stream_Type) return String;
overriding procedure Reset (Resource : in out Stream_Type);
overriding procedure Set_Index
(Resource : in out Stream_Type;
To : Stream_Element_Offset);
overriding procedure Close (Resource : in out Stream_Type);
private
-- implementation removed
end AWS.Resources.Streams.Disk;
13.40. AWS.Resources.Streams.Disk.Once¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- An ready-to-use implementation of the stream API where the stream content
-- is read from an on-disk file. The file is removed from the file system
-- when the transfer is completed.
package AWS.Resources.Streams.Disk.Once is
type Stream_Type is new Disk.Stream_Type with null record;
overriding procedure Close (Resource : in out Stream_Type);
-- Only redefine Close that will not only close the stream but also delete
-- the file.
end AWS.Resources.Streams.Disk.Once;
13.41. AWS.Resources.Streams.Memory¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- API to handle a memory stream. A memory stream is first created
-- empty. User can add chunk of data using the Append routines. The stream
-- is then read using the Read procedure.
with AWS.Utils;
private with AWS.Containers.Memory_Streams;
package AWS.Resources.Streams.Memory is
type Stream_Type is new Streams.Stream_Type with private;
subtype Stream_Element_Access is Utils.Stream_Element_Array_Access;
subtype Buffer_Access is Utils.Stream_Element_Array_Constant_Access;
procedure Append
(Resource : in out Stream_Type;
Buffer : Stream_Element_Array;
Trim : Boolean := False);
-- Append Buffer into the memory stream
procedure Append
(Resource : in out Stream_Type;
Buffer : Stream_Element_Access);
-- Append static data pointed to Buffer into the memory stream as is.
-- The stream will free the memory on close.
procedure Append
(Resource : in out Stream_Type;
Buffer : Buffer_Access);
-- Append static data pointed to Buffer into the memory stream as is.
-- The stream would not try to free the memory on close.
overriding procedure Read
(Resource : in out Stream_Type;
Buffer : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- Returns a chunck of data in Buffer, Last point to the last element
-- returned in Buffer.
overriding function End_Of_File (Resource : Stream_Type) return Boolean;
-- Returns True if the end of the memory stream has been reached
procedure Clear (Resource : in out Stream_Type) with Inline;
-- Delete all data from memory stream
overriding procedure Reset (Resource : in out Stream_Type);
-- Reset the streaming data to the first position
overriding procedure Set_Index
(Resource : in out Stream_Type;
To : Stream_Element_Offset);
-- Set the position in the stream, next Read will start at the position
-- whose index is To.
overriding function Size
(Resource : Stream_Type) return Stream_Element_Offset;
-- Returns the number of bytes in the memory stream
overriding procedure Close (Resource : in out Stream_Type);
-- Close the memory stream. Release all memory associated with the stream
private
-- implementation removed
end AWS.Resources.Streams.Memory;
13.42. AWS.Resources.Streams.Memory.ZLib¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2013, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This API is used as for standard memory stream (see parent package), the
-- only difference is that the stream is compressing/decompressing on append.
with ZLib;
package AWS.Resources.Streams.Memory.ZLib is
package ZL renames Standard.ZLib;
type Stream_Type is new Memory.Stream_Type with private;
subtype Window_Bits_Type is ZL.Window_Bits_Type;
subtype Header_Type is ZL.Header_Type;
subtype Compression_Level is ZL.Compression_Level;
subtype Strategy_Type is ZL.Strategy_Type;
subtype Compression_Method is ZL.Compression_Method;
subtype Memory_Level_Type is ZL.Memory_Level_Type;
Default_Compression : constant Compression_Level := ZL.Default_Compression;
Default_Header : constant Header_Type := ZL.Default;
procedure Deflate_Initialize
(Resource : in out Stream_Type;
Level : Compression_Level := ZL.Default_Compression;
Strategy : Strategy_Type := ZL.Default_Strategy;
Method : Compression_Method := ZL.Deflated;
Window_Bits : Window_Bits_Type := ZL.Default_Window_Bits;
Memory_Level : Memory_Level_Type := ZL.Default_Memory_Level;
Header : Header_Type := ZL.Default)
with Inline;
-- Initialize the compression
procedure Inflate_Initialize
(Resource : in out Stream_Type;
Window_Bits : Window_Bits_Type := ZL.Default_Window_Bits;
Header : Header_Type := ZL.Default)
with Inline;
-- Initialize the decompression
overriding procedure Append
(Resource : in out Stream_Type;
Buffer : Stream_Element_Array;
Trim : Boolean := False);
-- Compress/decompress and Append Buffer into the memory stream
overriding procedure Read
(Resource : in out Stream_Type;
Buffer : out Stream_Element_Array;
Last : out Stream_Element_Offset);
-- Returns a chunck of data in Buffer, Last point to the last element
-- returned in Buffer.
overriding function Size
(Resource : Stream_Type) return Stream_Element_Offset;
-- Returns the number of bytes in the memory stream
overriding procedure Close (Resource : in out Stream_Type);
-- Close the ZLib stream, release all memory associated with the Resource
-- object.
private
-- implementation removed
end AWS.Resources.Streams.Memory.ZLib;
13.43. AWS.Resources.Streams.Pipe¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2007-2016, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- An ready-to-use implementation of the stream API where the stream content
-- is read from a pipe.
with GNAT.OS_Lib;
private with Ada.Strings.Unbounded;
private with GNAT.Expect;
package AWS.Resources.Streams.Pipe is
use GNAT;
type Stream_Type is new Streams.Stream_Type with private;
type On_Error_Callback is
access procedure (Status : Integer; Error : String);
procedure Open
(Pipe : out Stream_Type;
Command : String;
Args : OS_Lib.Argument_List;
Timeout : Integer := 10_000;
On_Error : On_Error_Callback := null);
-- Open the pipe and connect it to the given command's output. Args are
-- passed to the command. Timeout is given in milliseconds and corresponds
-- to the time waiting for output data before timeout. This timeout must be
-- adjusted to be compatible to the output activity of the Command process.
overriding function End_Of_File (Resource : Stream_Type) return Boolean;
overriding procedure Read
(Resource : in out Stream_Type;
Buffer : out Stream_Element_Array;
Last : out Stream_Element_Offset);
overriding procedure Close (Resource : in out Stream_Type);
overriding procedure Reset (Resource : in out Stream_Type) is null;
-- Does nothing as not supported on pipe streams
overriding procedure Set_Index
(Resource : in out Stream_Type;
To : Stream_Element_Offset) is null;
-- Does nothing as not supported on pipe streams
private
-- implementation removed
end AWS.Resources.Streams.Pipe;
13.44. AWS.Response¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This package is to be used to build answer to be sent to the client
-- browser. It is also used as the object returned from the client API. So
-- it is either a response built on the server side or the response received
-- on the client side.
with Ada.Calendar;
with Ada.Streams;
with Ada.Strings.Unbounded;
with AWS.Headers;
with AWS.Messages;
with AWS.MIME;
with AWS.Net;
with AWS.Resources.Streams;
with AWS.Status;
private with Ada.Finalization;
private with Ada.Unchecked_Deallocation;
package AWS.Response is
use Ada;
use Ada.Streams;
use Ada.Strings.Unbounded;
use type AWS.Messages.Status_Code;
type Data is private;
-- Note that this type use a reference counter which is not thread safe
type Callback is access function (Request : Status.Data) return Data;
-- This is the Web Server Callback procedure. A client must declare and
-- pass such procedure to the HTTP server.
type Data_Mode is
(Header, -- Send only the HTTP header
Message, -- Send a standard HTTP message
File, -- Send a file
File_Once, -- Send a file once, delete it after sending
Stream, -- Send a stream
Socket_Taken, -- Socket has been taken from the server
WebSocket, -- Protocol switched to WebSocket
No_Data); -- No data, this is not a response
type Authentication_Mode is (Unknown, Any, Basic, Digest);
-- The authentication mode.
-- "Basic" and "Digest" mean that server must accept the requested
-- authentication mode. "Any" mean that server could accept any
-- authentication from client.
-- Unknown, means that an unsupported mode has been found.
-- Note the order here should not be changed as it is used in AWS.Client.
subtype Content_Length_Type
is Stream_Element_Offset range -1 .. Stream_Element_Offset'Last;
Undefined_Length : constant Content_Length_Type;
-- Undefined length could be used when we do not know the message length
-- at the start of transfer. The end of message could be determined by the
-- chunked transfer-encoding in the HTTP/1.1, or by the closing connection
-- in the HTTP/1.0.
Default_Moved_Message : constant String;
-- This is a template message, _@_ will be replaced by the Location (see
-- function Build with Location below).
Default_Authenticate_Message : constant String;
-- This is the message that will be displayed on the Web Browser if the
-- authentication process fails or is cancelled.
-----------------------
-- Data Constructors --
-----------------------
function Build
(Content_Type : String;
Message_Body : String;
Status_Code : Messages.Status_Code := Messages.S200;
Cache_Control : Messages.Cache_Option := Messages.Unspecified;
Encoding : Messages.Content_Encoding := Messages.Identity)
return Data
with Post => not Is_Empty (Build'Result)
and then Response.Status_Code (Build'Result) = Status_Code;
function Build
(Content_Type : String;
UString_Message : Unbounded_String;
Status_Code : Messages.Status_Code := Messages.S200;
Cache_Control : Messages.Cache_Option := Messages.Unspecified;
Encoding : Messages.Content_Encoding := Messages.Identity)
return Data
with Post => not Is_Empty (Build'Result)
and then Response.Status_Code (Build'Result) = Status_Code;
-- Return a message whose body is passed into Message_Body. The
-- Content_Type parameter is the MIME type for the message
-- body. Status_Code is the response status (see Messages.Status_Code
-- definition).
function Build
(Content_Type : String;
Message_Body : Stream_Element_Array;
Status_Code : Messages.Status_Code := Messages.S200;
Cache_Control : Messages.Cache_Option := Messages.Unspecified;
Encoding : Messages.Content_Encoding := Messages.Identity)
return Data
with Post => not Is_Empty (Build'Result)
and then Response.Status_Code (Build'Result) = Status_Code;
-- Idem above, but the message body is a stream element array
type Disposition_Mode is (Attachment, Inline, None);
-- Describes the way a file/stream is sent to the browser.
--
-- Attachment : The file is sent as an attachment, the browser
-- wont display the content even if the MIME type
-- is supported (.txt or .doc on IE for example).
--
-- Inline : The file can be displayed inside the browser if
-- MIME type is supported. If not the browser will
-- propose to save this file.
--
-- None : No specific setting is sent to the browser. The
-- browser default setting will be used. Note that in
-- this case the browser determine the filename using
-- the URI. This is the default setting.
function File
(Content_Type : String;
Filename : String;
Status_Code : Messages.Status_Code := Messages.S200;
Cache_Control : Messages.Cache_Option := Messages.Unspecified;
Encoding : Messages.Content_Encoding := Messages.Identity;
Once : Boolean := False;
Disposition : Disposition_Mode := None;
User_Filename : String := "")
return Data
with Post => not Is_Empty (File'Result)
and then Response.Status_Code (File'Result) = Status_Code
and then (if Once
then Mode (File'Result) = File_Once
else Mode (File'Result) = File);
-- Returns a message whose message body is the content of the file. The
-- Content_Type must indicate the MIME type for the file. User_Filename
-- can be used to force the filename on the client side. This can be
-- different from the server side Filename. If Once is set to True the
-- file will be deleted after the download (this includes the case where
-- the download is suspended).
function Stream
(Content_Type : String;
Handle : not null access Resources.Streams.Stream_Type'Class;
Status_Code : Messages.Status_Code := Messages.S200;
Cache_Control : Messages.Cache_Option := Messages.No_Cache;
Encoding : Messages.Content_Encoding := Messages.Identity;
Server_Close : Boolean := True;
Disposition : Disposition_Mode := None;
User_Filename : String := "")
return Data
with Post => not Is_Empty (Stream'Result)
and then Response.Status_Code (Stream'Result) = Status_Code;
-- Returns a message whose message body is the content of the user defined
-- stream. The Content_Type must indicate the MIME type for the data
-- stream, Status_Code is the the header status code which should be send
-- back to client's browser. If Server_Close is set to False the server
-- will not close the stream after sending it, it is then user's
-- responsability to close the stream. User_Filename can be used to force
-- the filename on the client side. This can be different from the server
-- side filename (for file based stream) or can be used to name a non disk
-- based stream. Encoding mean additional encoding would be applied on top
-- of given Handler stream.
------------------------------
-- Redirection Constructors --
------------------------------
function URL
(Location : String;
Cache_Control : Messages.Cache_Option := Messages.Unspecified)
return Data
with Post => not Is_Empty (URL'Result)
and then Status_Code (URL'Result) = Messages.S302
and then Mode (URL'Result) = Header;
-- This ask the server for a redirection to the specified URL. This is
-- a temporary redirection, and the client browser should query the
-- same original URL next time.
function Moved
(Location : String;
Message : String := Default_Moved_Message;
Content_Type : String := AWS.MIME.Text_HTML;
Cache_Control : Messages.Cache_Option := Messages.Unspecified)
return Data
with Post => not Is_Empty (Moved'Result)
and then Status_Code (Moved'Result) = Messages.S301;
-- This send back a moved message (Messages.S301) with the specified
-- message body and content type.
-- This is a permanent redirection, and the client browser is encouraged
-- to update links so that the next query for the URL goes directly to
-- the new location.
------------------------
-- Other Constructors --
------------------------
function Acknowledge
(Status_Code : Messages.Status_Code;
Message_Body : String := "";
Content_Type : String := MIME.Text_HTML) return Data
with Post =>
not Is_Empty (Acknowledge'Result)
and then Response.Status_Code (Acknowledge'Result) = Status_Code
and then (if Message_Body = ""
then Mode (Acknowledge'Result) = Header);
-- Returns a message to the Web browser. This routine must be used to
-- send back an error message to the Web browser. For example if a
-- requested resource cannot be served a message with status code S404
-- must be sent.
function Authenticate
(Realm : String;
Mode : Authentication_Mode := Basic;
Stale : Boolean := False;
Message : String := Default_Authenticate_Message)
return Data
with Post => not Is_Empty (Authenticate'Result)
and then Status_Code (Authenticate'Result) = Messages.S401;
-- Returns an authentication message (Messages.S401), the Web browser
-- will then ask for an authentication. Realm string will be displayed
-- by the Web Browser in the authentication dialog box.
function Socket_Taken return Data with
Post => not Is_Empty (Socket_Taken'Result)
and then Mode (Socket_Taken'Result) = Socket_Taken;
-- Must be used to say that the connection socket has been taken by user
-- inside of user callback. No operations should be performed on this
-- socket, and associated slot should be released for further operations.
function Empty return Data with
Post => Status_Code (Empty'Result) = Messages.S204
and then Mode (Empty'Result) = No_Data;
-- Returns an empty message (Data_Mode = No_Data and Status_Code is 204).
-- It is used to say that user's handlers were not able to do something
-- with the request. This is used by the callback's chain in the
-- dispatchers and should not be used by users.
--
-- API to retrieve response data
--
------------
-- Header --
------------
function Header (D : Data; Name : String; N : Positive) return String
with Inline;
-- Return the N-th value for header Name
function Header (D : Data; Name : String) return String with Inline;
-- Return all values as a comma-separated string for header Name.
-- See [RFC 2616 - 4.2] last paragraph.
function Header (D : Data) return AWS.Headers.List;
function Has_Header (D : Data; Name : String) return Boolean with Inline;
-- Returns True if D headers contains Name
procedure Send_Header (Socket : Net.Socket_Type'Class; D : Data)
with Inline;
-- Send all header lines to the socket
function Status_Code (D : Data) return Messages.Status_Code with Inline;
-- Returns the status code
function Content_Length (D : Data) return Content_Length_Type with Inline;
-- Returns the content length (i.e. the message body length). A value of 0
-- indicate that there is no message body.
function Content_Type (D : Data) return String with Inline;
-- Returns the MIME type for the message body
function Cache_Control (D : Data) return Messages.Cache_Option with Inline;
-- Returns the cache control specified for the response
function Cache_Control (D : Data) return Messages.Cache_Data;
-- As above but returns a structured record of type "Cache_Data (Request)"
-- representing the cache options.
function Expires (D : Data) return Calendar.Time with Inline;
-- Returns the Expires date as a time value
function Location (D : Data) return String with Inline;
-- Returns the location for the new page in the case of a moved
-- message. See Moved constructor above.
----------
-- Data --
----------
function Mode (D : Data) return Data_Mode with Inline;
-- Returns the data mode, either Header, Message or File
function Is_Empty (D : Data) return Boolean with Inline;
-- Returns True if D.Mode is No_Data
function Message_Body (D : Data) return String with Inline;
-- Returns the message body content as a string.
-- Message_Body routines could not be used with user defined streams
-- (see. Stream routine in this package). Constraint_Error would be raised
-- on try to get data by the Message_Body from the user defined streams.
-- For get data from user defined streams routine Create_Resource should
-- be used.
function Message_Body (D : Data) return Unbounded_String;
-- Returns message body content as an unbounded_string
function Message_Body (D : Data) return Stream_Element_Array;
-- Returns message body as a binary content
procedure Message_Body
(D : Data;
File : out AWS.Resources.File_Type);
-- Returns the message body as a stream
function Filename (D : Data) return String with Inline;
-- Returns the filename which should be sent back or the filename which
-- was containing the response for a server response.
--------------------
-- Authentication --
--------------------
function Realm (D : Data) return String with Inline;
-- Returns the Realm for the current authentication request
function Authentication (D : Data) return Authentication_Mode with Inline;
-- Returns the authentication mode requested by server
function Authentication_Stale (D : Data) return Boolean with Inline;
-- Returns the stale parameter for authentication
---------------
-- Resources --
---------------
procedure Create_Resource
(D : in out Data;
File : out AWS.Resources.File_Type;
GZip : Boolean)
with Inline;
-- Creates the resource object (either a file or in-memory object) for
-- the data to be sent to the client. The resource should be closed after
-- use.
-- GZip is true when the http client support GZip decoding,
-- if file or embedded resource is in the GZip format this routine would
-- define Content-Encoding header field value.
function Close_Resource (D : Data) return Boolean;
-- Returns True if the resource stream must be close
function Keep_Alive (D : Data) return Boolean with Inline;
-- Returns True if the user want to keep connection alive
----------------
-- WebSockets --
----------------
function WebSocket return Data with
Post => not Is_Empty (WebSocket'Result)
and then Status_Code (WebSocket'Result) = Messages.S101
and then Mode (WebSocket'Result) = WebSocket;
-- WebSocket handshake from initial WebSocket connection
private
-- implementation removed
end AWS.Response;
13.45. AWS.Server¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with AWS.Config;
with AWS.Default;
with AWS.Dispatchers;
with AWS.Exceptions;
with AWS.Net.SSL;
with AWS.Response;
with AWS.Status;
private with Ada.Calendar;
private with Ada.Exceptions;
private with Ada.Finalization;
private with Ada.Task_Attributes;
with Ada.Task_Identification;
private with Ada.Real_Time;
private with System;
private with AWS.Log;
private with AWS.Net.Acceptors;
private with AWS.Hotplug;
private with AWS.Utils;
package AWS.Server is
type HTTP is limited private;
-- A Web server
---------------------------
-- Server initialization --
---------------------------
-- Note that starting a sercure server if AWS has not been configured to
-- support HTTPS will raise Program_Error.
procedure Start
(Web_Server : in out HTTP;
Callback : Response.Callback;
Config : AWS.Config.Object);
-- Start server using a full configuration object. With this routine it is
-- possible to control all features of the server. A simplified version of
-- Start is also provided below with the most common options.
procedure Start
(Web_Server : in out HTTP;
Dispatcher : Dispatchers.Handler'Class;
Config : AWS.Config.Object);
-- Idem, but using the dispatcher tagged type instead of callback. See
-- AWS.Services.Dispatchers and AWS.Dispatchers hierarchies for built-in
-- services and interface to build your own dispatcher models.
-- Note that a copy of the Dispatcher is keept into Web_Server. Any
-- changes done to the Dispatcher object will not be part of the Web
-- server dispatcher.
procedure Get_Message_Body;
-- If size of message body is bigger than Upload_Size_Limit configuration
-- parameter, server do not receive message body before calling user's
-- callback routine. If user decide to get the message body he should call
-- this routine.
procedure Start
(Web_Server : in out HTTP;
Name : String;
Callback : Response.Callback;
Max_Connection : Positive := Default.Max_Connection;
Admin_URI : String := Default.Admin_URI;
Port : Natural := Default.Server_Port;
Security : Boolean := False;
Session : Boolean := False;
Case_Sensitive_Parameters : Boolean := True;
Upload_Directory : String := Default.Upload_Directory;
Line_Stack_Size : Positive := Default.Line_Stack_Size);
-- Start the Web server. Max_Connection is the number of simultaneous
-- connections the server's will handle (the number of slots in AWS).
-- Name is just a string used to identify the server. This is used
-- for example in the administrative page. Admin_URI must be set to enable
-- the administrative status page. Callback is the procedure to call for
-- each resource requested. Port is the Web server port. If Security is
-- set to True the server will use an HTTPS/SSL connection. If Session is
-- set to True the server will be able to get a status for each client
-- connected. A session Id is used for that, on the client side it is a
-- cookie. Case_Sensitive_Parameters if set to False it means that the
-- parameters name will be handled without case sensitivity. Upload
-- directory point to a directory where uploaded files will be stored.
------------------------
-- Server termination --
------------------------
procedure Shutdown (Web_Server : in out HTTP);
-- Stop the server and release all associated memory. This routine can
-- take some time to terminate because it waits for all tasks to terminate
-- properly before releasing the memory. The log facilities will be
-- automatically stopped by calling Stop_Log below.
type Termination is (No_Server, Q_Key_Pressed, Forever);
procedure Wait (Mode : Termination := No_Server);
-- The purpose of this procedure is to control the main procedure
-- termination. This procedure will return only when no server are running
-- (No_Server mode) or the 'q' key has been pressed. If mode is set to
-- Forever, Wait will never return and the process will have to be killed.
--------------------------
-- Server configuration --
--------------------------
function Config (Web_Server : HTTP) return AWS.Config.Object;
-- Returns configuration object for Web_Server
procedure Set_Unexpected_Exception_Handler
(Web_Server : in out HTTP;
Handler : Exceptions.Unexpected_Exception_Handler);
-- Set the unexpected exception handler. It is called whenever an
-- unrecoverable error has been detected. The default handler just display
-- (on standard output) an error message with the location of the
-- error. By changing this handler it is possible to log or display full
-- symbolic stack backtrace if needed.
procedure Set
(Web_Server : in out HTTP;
Dispatcher : Dispatchers.Handler'Class);
-- Dynamically associate a new dispatcher object to the server. With the
-- feature it is possible to change server behavior at runtime. The
-- complete set of callback procedures will be changed when calling this
-- routine. Note that any change in a dispatcher associated with a server
-- using Register or Unregister must be reset into the server using this
-- routine.
procedure Set_Security
(Web_Server : in out HTTP;
Certificate_Filename : String;
Security_Mode : Net.SSL.Method := Net.SSL.TLS_Server;
Key_Filename : String := "");
-- Set security option for AWS. Certificate_Filename is the name of a file
-- containing a certificate. Key_Filename is the name of the file
-- containing the key, if the empty string the key will be taken from the
-- certificate filename. This must be called before starting the secure
-- server otherwise the default security options or options set in the
-- config files will be used. After that the call will have no effect.
procedure Set_SSL_Config
(Web_Server : in out HTTP; SSL_Config : Net.SSL.Config);
-- Set the SSL configuration for this server
function SSL_Config
(Web_Server : in out HTTP) return not null access Net.SSL.Config;
-- Returns the access to SSL config of the server. Allow to change SSL
-- config on the already created server.
procedure Set_Socket_Constructor
(Web_Server : in out HTTP;
Socket_Constructor : Net.Socket_Constructor);
-- Set the socket constructor routine to use when creating new sockets on
-- the server. By calling this routine it is possible to replace the
-- default AWS communication layer used. The default constructor is
-- AWS.Net.Socket. Note that this routine must be called before starting
-- the server. It is also important to note that sockets returned by the
-- constructor must have the cache properly initialized. See AWS.Net.Cache
-- for more information.
type HTTP_Access is access all HTTP;
function Get_Current return not null access HTTP;
-- Get current server. This can be used in a callback procedure to
-- retrieve the running HTTP server. It is needed when a callback
-- procedure is shared by multiple servers.
function Get_Status return Status.Data;
-- Returns the current status data. This is useful to get the full status
-- in a templates engine callback procedure for example.
function Session_Name return String;
-- Returns the current session cookie name
function Session_Private_Name return String;
-- Returns the current private session cookie name
---------------
-- Other API --
---------------
procedure Give_Back_Socket
(Web_Server : in out HTTP; Socket : Net.Socket_Type'Class);
-- Give the socket back to the server. Socket must have been taken from
-- the server using the Response.Socket_Taken routine in a callback.
procedure Give_Back_Socket
(Web_Server : in out HTTP;
Socket : not null access Net.Socket_Type'Class);
-- Idem.
-- Use Socket_Access to avoid memory reallocation for already allocated
-- sockets.
procedure Set_Field (Id, Value : String);
-- Set the extended log field value for the server the controlling the
-- current task.
procedure Skip_Log_Record;
-- Disable logging only for the current processing request
procedure Add_Listening
(Web_Server : in out HTTP;
Host : String;
Port : Natural;
Family : Net.Family_Type := Net.Family_Unspec;
Reuse_Address : Boolean := False;
IPv6_Only : Boolean := False);
-- Add the binded/listening socket on host, port and protocol family. To be
-- able to connect web enabled application with others in the internal
-- network, and then give access for external clients by listening on
-- externally available address. Also it could be used to bind one server
-- to IPv4 and IPv6 protocols simultaneously.
-- IPv6_Only allows restrict IPv6 server to accept only IPv6 connections.
type Task_Id_Array is
array (Positive range <>) of Ada.Task_Identification.Task_Id;
function Line_Tasks (Web_Server : HTTP) return Task_Id_Array;
-- Returns line tasks identifiers
private
-- implementation removed
end AWS.Server;
13.46. AWS.Server.Hotplug¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with AWS.Hotplug;
package AWS.Server.Hotplug is
-- Messages used to register/unregister hotplug modules
Register_Message : constant String := "REGISTER";
Unregister_Message : constant String := "UNREGISTER";
Request_Nonce_Message : constant String := "REQUEST_NONCE";
-- The Authorization_File below is a file that contains authorizations
-- for the hotplug modules. Only modules that have an entry into this
-- file will be able to register to server. Each line on this file must
-- have the following format:
--
-- <module_name>:<md5_password>:<host>:<port>
--
-- module_name : The name of the module that will register
-- md5_password : The corresponding password, use aws_password
-- tool to generate such password
-- host : The host name where requests will be redirected
-- port : and the corresponding port
procedure Activate
(Web_Server : not null access HTTP;
Port : Positive;
Authorization_File : String;
Register_Mode : AWS.Hotplug.Register_Mode := AWS.Hotplug.Add;
Host : String := "");
-- Start hotplug server listening at the specified Port for the Web_Server.
-- Only client modules listed in the authorization file will be able to
-- connect to this server. For better securite the host of redictection
-- must also be specified.
procedure Shutdown;
-- Shutdown hotplug server
end AWS.Server.Hotplug;
13.47. AWS.Server.Log¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with AWS.Log;
package AWS.Server.Log is
------------------
-- Standard Log --
------------------
procedure Start
(Web_Server : in out HTTP;
Split_Mode : AWS.Log.Split_Mode := AWS.Log.None;
Filename_Prefix : String := "";
Auto_Flush : Boolean := False);
-- Activate server's logging activity. See AWS.Log. If Auto_Flush is True
-- the file will be flushed after all written data.
procedure Start
(Web_Server : in out HTTP;
Callback : AWS.Log.Callback;
Name : String);
-- Activate the Web_Server access log and direct all data to the Callback.
-- The Name String is returned when the Name function is called. It is a
-- simple identifier, that serves no other purpose than to give the
-- Callback a label.
function Name (Web_Server : HTTP) return String;
-- Return the name of the Log or an empty string if one is not active. If
-- an external writer is used to handle the access log, then the name of
-- that writer is returned. See the Start procedure for starting the access
-- log with a Callback.
procedure Stop (Web_Server : in out HTTP);
-- Stop server's logging activity. See AWS.Log
function Is_Active (Web_Server : HTTP) return Boolean;
-- Returns True if the Web Server log has been activated
procedure Flush (Web_Server : in out HTTP);
-- Flush the server log.
-- Note that error log does not need to be flushed because it is always
-- flushed by default. If a Callback procedure is used to handle the log
-- data, then calling Flush does nothing.
---------------
-- Error Log --
---------------
procedure Start_Error
(Web_Server : in out HTTP;
Split_Mode : AWS.Log.Split_Mode := AWS.Log.None;
Filename_Prefix : String := "");
-- Activate server's logging activity. See AWS.Log
procedure Start_Error
(Web_Server : in out HTTP;
Callback : AWS.Log.Callback;
Name : String);
-- Activate the Web_Server error log and direct all data to the Callback.
-- The Name String is returned when the Error_Name function is called. It
-- is a simple identifier, that serves no other purpose than to give the
-- Callback a label.
function Error_Name (Web_Server : HTTP) return String;
-- Return the name of the Error Log or an empty string if one is not
-- active. If a Callback is used to handle the error log, then the name of
-- the Callback is returned. See the Start_Error procedure for starting the
-- error log with a Callback.
procedure Stop_Error (Web_Server : in out HTTP);
-- Stop server's logging activity. See AWS.Log
function Is_Error_Active (Web_Server : HTTP) return Boolean;
-- Returns True if the Web Server error log has been activated
end AWS.Server.Log;
13.48. AWS.Server.Push¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Package to support Server Push feature. This is only supported by Netscape
-- browsers. It will not work with Microsoft Internet Explorer.
-- For Microsoft Internet Explorer complementary active components
-- should be used like java applets or ActiveX controls.
with Ada.Calendar;
with Ada.Streams;
with Ada.Strings.Unbounded;
with AWS.Containers.Tables;
with AWS.Default;
with AWS.Net;
with System;
private with Ada.Containers.Indefinite_Hashed_Sets;
private with Ada.Containers.Indefinite_Hashed_Maps;
private with Ada.Containers.Indefinite_Doubly_Linked_Lists;
private with Ada.Strings.Hash;
generic
type Client_Output_Type (<>) is private;
-- Data type client want to send through server push
type Client_Environment is private;
-- Data type to keep client context. This context will be passed to the
-- conversion routine below.
with function To_Stream_Array
(Output : Client_Output_Type;
Client : Client_Environment) return Ada.Streams.Stream_Element_Array;
-- Function used for convert Client_Output_Type to Stream_Output_Type.
-- This is used by the server to prepare the data to be sent to the
-- clients.
package AWS.Server.Push is
use Ada;
use Ada.Streams;
use Ada.Strings.Unbounded;
Client_Gone : exception;
-- Raised when a client is not responding
Closed : exception;
-- Raised when trying to register to a closed push server
Duplicate_Client_Id : exception;
-- Raised in trying to register an already registered client
type Object is limited private;
-- This is the push server object. A push server has two modes, either it
-- is Open or Closed. When open it will send data to registered
-- clients. No data will be sent to registered client if the server is
-- Closed.
type Mode is (Plain, Multipart, Chunked);
-- Described the mode to communicate with the client.
-- Plain : no transformation is done, the data are sent as-is
-- Multipart : data are MIME encoded.
-- Chuncked : data are chunked, a piece of data is sent in small pieces.
subtype Client_Key is String;
-- The Client Id key representation. In a server each client must have a
-- uniq ID. This Id is used for registration and for sending data to
-- specific client.
type Wait_Counter_Type is mod System.Max_Binary_Modulus;
subtype Group_Set is Containers.Tables.VString_Array;
Empty_Group : constant Group_Set := (1 .. 0 => Null_Unbounded_String);
procedure Register
(Server : in out Object;
Client_Id : Client_Key;
Socket : Net.Socket_Access;
Environment : Client_Environment;
Init_Data : Client_Output_Type;
Init_Content_Type : String := "";
Kind : Mode := Plain;
Duplicated_Age : Duration := Duration'Last;
Groups : Group_Set := Empty_Group;
Timeout : Duration := Default.Send_Timeout);
-- Add client identified by Client_Id to the server subscription
-- list and send the Init_Data (as a Init_Content_Type mime content) to
-- him. After registering this client will be able to receive pushed data
-- from the server in broadcasting mode.
-- If Duplicated_Age less than age of the already registered same Client_Id
-- then old one will be unregistered first (no exception will be raised).
-- The Timeout is not for socket send timeout, but for internal waiting for
-- write availability timeout.
procedure Register
(Server : in out Object;
Client_Id : Client_Key;
Socket : Net.Socket_Type'Class;
Environment : Client_Environment;
Init_Data : Client_Output_Type;
Init_Content_Type : String := "";
Kind : Mode := Plain;
Duplicated_Age : Duration := Duration'Last;
Groups : Group_Set := Empty_Group;
Timeout : Duration := Default.Send_Timeout);
-- Same as above but with Socket_Type'Class parameter.
-- Is not recommended, use above one with Socket_Access parameter.
procedure Register
(Server : in out Object;
Client_Id : Client_Key;
Socket : Net.Socket_Type'Class;
Environment : Client_Environment;
Content_Type : String := "";
Kind : Mode := Plain;
Duplicated_Age : Duration := Duration'Last;
Groups : Group_Set := Empty_Group;
Timeout : Duration := Default.Send_Timeout);
-- Same as above but without sending initial data.
-- Content_Type applicable only when Kind parameter is Plain or Chunked,
-- in Multipart server push mode each server push message would have own
-- Content_Type defined.
-- Is not recommended, use above one with Socket_Access parameter.
procedure Unregister
(Server : in out Object;
Client_Id : Client_Key;
Close_Socket : Boolean := True);
-- Removes client Client_Id from server subscription list. The associated
-- client's socket will be closed if Close_Socket is True. No exception is
-- raised if Client_Id was not registered.
procedure Unregister_Clients
(Server : in out Object; Close_Sockets : Boolean := True);
-- Remove all registered clients from the server. Closes if Close_Sockets
-- is set to True (default) otherwise the sockets remain open. After this
-- call the sever will still in running mode. Does nothing if there is no
-- client registered.
procedure Subscribe
(Server : in out Object; Client_Id : Client_Key; Group_Id : String);
-- Subscribe client to the group
procedure Subscribe_Copy
(Server : in out Object; Source : String; Target : String);
-- Subscribe everybody in the group Source to the group Target.
-- If Source is empty then subscribe all clients to the group Target.
procedure Unsubscribe
(Server : in out Object; Client_Id : Client_Key; Group_Id : String);
-- Remove group from client's group list
procedure Unsubscribe_Copy
(Server : in out Object; Source : String; Target : String);
-- Unsubscribe everybody in the group Source from the group Target.
-- If Source is empty then unsubscribe all clients from the group Target.
procedure Send_To
(Server : in out Object;
Client_Id : Client_Key;
Data : Client_Output_Type;
Content_Type : String := "";
Thin_Id : String := "");
-- Push data to a specified client identified by Client_Id
-- Thin_Id is to be able to replace messages in the send client queue
-- with the newer one with the same Thin_Id.
procedure Send
(Server : in out Object;
Data : Client_Output_Type;
Group_Id : String := "";
Content_Type : String := "";
Thin_Id : String := "";
Client_Gone : access procedure (Client_Id : String) := null);
-- Push data to group of clients (broadcast) subscribed to the server.
-- If Group_Id is empty, data transferred to each client.
-- Call Client_Gone for each client with broken socket.
-- Thin_Id is to be able to replace messages in the send client queue
-- with the newer one with the same Thin_Id.
generic
with procedure Client_Gone (Client_Id : String);
procedure Send_G
(Server : in out Object;
Data : Client_Output_Type;
Group_Id : String := "";
Content_Type : String := "";
Thin_Id : String := "");
-- Same like before, but generic for back compatibility
function Count (Server : Object) return Natural;
-- Returns the number of registered clients in the server
procedure Info
(Server : in out Object;
Clients : out Natural;
Groups : out Natural;
Process : access procedure
(Client_Id : Client_Key;
Address : String;
State : String;
Environment : Client_Environment;
Kind : Mode;
Groups : Group_Set) := null);
-- Returns the number of registered clients and groups in the server.
-- Call Process routine for each client if defined.
-- Test internal integrity.
function Is_Open (Server : Object) return Boolean;
-- Return True if the server is open, meaning server is still running,
-- ready to accept client's registration and still sending data to
-- clients.
-- Shutdown routines put the server in a Closed mode. The routines below
-- provides a way to eventually close the socket, to send some
-- finalization data.
procedure Shutdown
(Server : in out Object; Close_Sockets : Boolean := True);
-- Unregistered all clients and close all associated connections (socket)
-- if Close_Socket is True. The server will be in Closed mode. After this
-- call any client trying to register will get the Closed exception. It is
-- possible to reactivate the server with Restart.
procedure Shutdown
(Server : in out Object;
Final_Data : Client_Output_Type;
Final_Content_Type : String := "");
-- Idem as above but it send Final_Data (as a Data_Content_Type mime
-- content) before closing connections.
procedure Shutdown_If_Empty (Server : in out Object; Open : out Boolean);
-- Server will be shutdown (close mode) if there is no more active clients
-- (Count = 0). Returns new server status in Open (Open will be True if
-- server is in Open mode and False otherwise). After this call any client
-- trying to register will get the Closed exception. It is possible to
-- reactivate the server with Restart.
procedure Restart (Server : in out Object);
-- Set server to Open mode. Server will again send data to registered
-- clients. It does nothing if server was already open.
procedure Info
(Size : out Natural;
Max_Size : out Natural;
Max_Size_DT : out Calendar.Time;
Counter : out Wait_Counter_Type);
-- Size would return number of currently waiting sockets.
-- Counter would return total number of waited sockets from start.
function Wait_Send_Completion (Timeout : Duration) return Boolean;
-- Wait for all data sending in all server_push objects of the current
-- package instance.
-- Return True if wait successful. False in timeout.
type Error_Handler is not null access procedure (Message : String);
procedure Set_Internal_Error_Handler (Handler : Error_Handler);
-- Set the handler of the internal fatal errors
private
-- implementation removed
end AWS.Server.Push;
13.49. AWS.Server.Status¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- This package provides routine to retrieve server's internal status
with Ada.Calendar;
with AWS.Net.Acceptors;
with AWS.Templates;
package AWS.Server.Status is
function Translations (Server : HTTP) return Templates.Translate_Set;
-- Returns a translate table to be used with a template file. This table
-- contains all internal server's data. This table is used by the server
-- internal status page for example.
function Translations (Server : HTTP) return Templates.Translate_Table;
pragma Obsolescent ("Use Translate_Set return value instead");
-- The same as above but obsolete and keept for backward compartibility
function Start_Time (Server : HTTP) return Ada.Calendar.Time;
-- Returns the server's start time
function Resources_Served (Server : HTTP) return Natural;
-- Returns the total number of resources (static file, templates,
-- in-memory string) served by the server.
function Socket (Server : HTTP) return Net.Socket_Type'Class;
-- Returns the main server's socket
function Sockets (Server : HTTP) return Net.Acceptors.Socket_List;
-- Returns all server's sockets
function Port (Server : HTTP) return Positive;
-- Returns the server's socket port
function Host (Server : HTTP) return String;
-- Returns the server's socket host
function Is_Any_Address (Server : HTTP) return Boolean;
-- Returns True if the server accepts connections on any of the host's
-- network addresses.
function Is_IPv6 (Server : HTTP) return Boolean;
-- Returns True if Server is using IPv6
function Local_URL (Server : HTTP) return String;
-- Local URL of the server
function Current_Connections (Server : HTTP) return Natural;
-- Returns the current number of connections
function Is_Session_Activated (Server : HTTP) return Boolean;
-- Returns True if the session feature has been activated
function Is_Security_Activated (Server : HTTP) return Boolean;
-- Returns True if the HTTPS protocol is used
function Is_Shutdown (Server : HTTP) return Boolean;
-- Returns True if server has been stopped (the server could still be in
-- the shutdown phase).
end AWS.Server.Status;
13.50. AWS.Services.Callbacks¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Services to be used to declare aliases based on URI. This is mostly
-- designed to be used with AWS.services.Dispatchers.URI.
with AWS.Response;
with AWS.Status;
package AWS.Services.Callbacks is
generic
Prefix : String; -- the prefix found in the URI
Directory : String; -- the directory where the file is
function File (Request : Status.Data) return Response.Data;
-- This is a callback function where URL:
-- http://<host>/<prefix>toto
-- references the file:
-- <directory>/toto
--
-- If the URL does not start with Prefix it returns a 404 error page.
-- This is designed to be use with AWS.Services.Dispatchers.URI.
end AWS.Services.Callbacks;
13.51. AWS.Services.Directory¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with AWS.Status;
with Templates_Parser;
-- This service can be used to browse a file system. The browsing mechanism
-- will gather information (filename, size, directory...) from a specified
-- directory name and will fill a translation table. This table will be used
-- with a template file to render the HTML document. You can design your own
-- browsing template file, here is a description of all tag variables defined
-- in the translation table:
--
-- URI (discrete)
-- The URI pointing to the directory parsed.
--
-- VERSION (discrete)
-- AWS version string.
--
-- IS_DIR_V (vector)
-- A list of booleans, indicate if Nth entry is a directory or not.
--
-- NAME_V (vector)
-- A list of filenames. Nth name is a directory if Nth entry in IS_DIR
-- is set to true.
--
-- SIZE_V (vector)
-- A list of sizes. Nth entry is the file size of the Nth entry in
-- NAMES.
--
-- TIME_V (vector)
-- A list of last modification times. Nth entry is is the last
-- modification time of the Nth entry in NAMES.
--
-- NAME_ORDR
-- Rule to either set ordering on name or to revert current name
-- ordering.
--
-- SNME_ORDR
-- Rule to either set ordering on name (case sensitive) or to revert
-- current name (case sensitive) ordering.
--
-- EXT_ORDR
-- Rule to either set ordering on extension or to revert current
-- extension ordering.
--
-- SEXT_ORDR
-- Rule to either set ordering on extension (case sensitive) or to
-- revert current extension (case sensitive) ordering.
--
-- MIME_ORDR
-- Rule to either set ordering on MIME type or to revert current MIME
-- type ordering.
--
-- DIR_ORDR
-- Rule to either set ordering on directory or to revert current
-- directory ordering.
--
-- SIZE_ORDR
-- Rule to either set ordering on size or to revert current size
-- ordering.
--
-- TIME_ORDR
-- Rule to either set ordering on time or to revert current time
-- ordering.
--
-- ORIG_ORDR
-- Rule to either set original ordering (file order as read on the file
-- system) or to revert current original ordering.
--
-- DIR_NAME_ORDR
-- Rule to either set ordering on directory/name or to revert current
-- directory/name ordering.
--
-- DIR_SNME_ORDR
-- Rule to either set ordering on directory/name (case sensitive) or to
-- revert current directory/name (case sensitive) ordering.
--
-- DIR_TIME_ORDR
-- Rule to either set ordering on directory/time or to revert current
-- directory/time ordering.
--
package AWS.Services.Directory is
use Templates_Parser;
function Browse
(Directory_Name : String;
Request : AWS.Status.Data) return Translate_Set;
-- Returns a translation table containing information parsed from
-- Directory_Name. This is supposed to be used with a directory template.
function Browse
(Directory_Name : String;
Template_Filename : String;
Request : AWS.Status.Data;
Translations : Translate_Set := Null_Set) return String;
-- Parses directory Directory_Name and use Templates_Parser to fill in the
-- template Template_Filename. It is possible to specified some specifics
-- tags in Translations.
end AWS.Services.Directory;
13.52. AWS.Services.Dispatchers¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2013, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
package AWS.Services.Dispatchers with Pure is
-- Services on the Dispatcher tree are to help building big servers.
-- Experiences shows that a lot of user's code is to check the value of a
-- specific URI or request method to call the right callback that will
-- handle the request. This code is a big "if/elsif/end if" that just hide
-- the real job. A dispatcher is to replace this code. Currently there is
-- five of them:
--
-- URI (AWS.Services.Dispatchers.URI)
-- to dispatch to a callback depending of the resource name.
--
-- Method (AWS.Services.Dispatchers.Method)
-- to dispatch to a callback depending of the request method.
--
-- Virtual_Host (AWS.Services.Dispatchers.Virtual_Host)
-- to dispatch to a callback depending on the host name. This is known
-- as virtual hosting and permit to have multiple servers on the same
-- machine using the same port.
--
-- Transient_Pages (AWS.Services.Dispatchers.Transient_Pages)
-- to handle transient pages, if the default user's callback returns
-- 404 this dispatcher checks if the requested resource is a transient
-- page.
--
-- Timer (AWS.Services.Dispatchers.Timer)
-- to dispatch to a specific callback depending on the current time.
--
-- Linker (AWS.Services.Dispatchers.Linker)
-- to link two dispatchers together, if the first one retruns 404 tries
-- the second one.
end AWS.Services.Dispatchers;
13.53. AWS.Services.Dispatchers.Linker¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2005-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Link two dispatchers together
with AWS.Dispatchers;
with AWS.Response;
with AWS.Status;
package AWS.Services.Dispatchers.Linker is
type Handler is new AWS.Dispatchers.Handler with private;
procedure Register
(Dispatcher : in out Handler;
First, Second : AWS.Dispatchers.Handler'Class);
-- Set the dispatcher first and second handler. The First handler will be
-- looked for before the second.
private
-- implementation removed
end AWS.Services.Dispatchers.Linker;
13.54. AWS.Services.Dispatchers.Method¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Dispatch a specific request to a callback depending on the request method
with AWS.Dispatchers;
with AWS.Response;
with AWS.Status;
package AWS.Services.Dispatchers.Method is
type Handler is new AWS.Dispatchers.Handler with private;
procedure Register
(Dispatcher : in out Handler;
Method : Status.Request_Method;
Action : AWS.Dispatchers.Handler'Class);
-- Register callback to use for a specific request method
procedure Register
(Dispatcher : in out Handler;
Method : Status.Request_Method;
Action : Response.Callback);
-- Idem as above but take a callback procedure as parameter
procedure Unregister
(Dispatcher : in out Handler;
Method : Status.Request_Method);
-- Removes Method from the list of request method to handle
procedure Register_Default_Callback
(Dispatcher : in out Handler;
Action : AWS.Dispatchers.Handler'Class);
-- Register the default callback. This will be used if no request method
-- have been activated.
private
-- implementation removed
end AWS.Services.Dispatchers.Method;
13.55. AWS.Services.Dispatchers.URI¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Dispatch a specific request to a callback depending on the URI
with AWS.Dispatchers;
with AWS.Response;
with AWS.Status;
with AWS.Utils;
private with Ada.Containers.Vectors;
private with Ada.Strings.Unbounded;
package AWS.Services.Dispatchers.URI is
type Handler is new AWS.Dispatchers.Handler with private;
procedure Register
(Dispatcher : in out Handler;
URI : String;
Action : AWS.Dispatchers.Handler'Class;
Prefix : Boolean := False);
-- Register URI to use the specified dispatcher. URI is the full string
-- that must match the resource requested (with the leading /). If Prefix
-- is True, only the URI prefix is checked.
procedure Register
(Dispatcher : in out Handler;
URI : String;
Action : Response.Callback;
Prefix : Boolean := False);
-- Idem as above but take a callback procedure as parameter
procedure Register_Regexp
(Dispatcher : in out Handler;
URI : String;
Action : AWS.Dispatchers.Handler'Class);
-- Register URI to use the specified dispatcher. URI is a regular
-- expression that must match the resource requested (with the leading /).
procedure Register_Regexp
(Dispatcher : in out Handler;
URI : String;
Action : Response.Callback);
-- Idem as above but take a callback procedure as parameter
procedure Unregister
(Dispatcher : in out Handler;
URI : String);
-- Removes URI from the list. URI is either a name or a regexp and must
-- have exactly the value used with Register.
procedure Register_Default_Callback
(Dispatcher : in out Handler;
Action : AWS.Dispatchers.Handler'Class);
-- Register the default callback. This will be used if no URI match
-- the request.
private
-- implementation removed
end AWS.Services.Dispatchers.URI;
13.56. AWS.Services.Dispatchers.Virtual_Host¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with AWS.Dispatchers;
with AWS.Response;
with AWS.Status;
private with Ada.Containers.Indefinite_Hashed_Maps;
private with Ada.Strings.Hash;
private with Ada.Strings.Unbounded;
package AWS.Services.Dispatchers.Virtual_Host is
type Handler is new AWS.Dispatchers.Handler with private;
procedure Register
(Dispatcher : in out Handler;
Virtual_Hostname : String;
Hostname : String);
-- Register Virtual_Hostname to be a redirection to the specified
-- hostname.
procedure Register
(Dispatcher : in out Handler;
Virtual_Hostname : String;
Action : AWS.Dispatchers.Handler'Class);
-- Register Virtual_Hostname to use the specified callback
procedure Register
(Dispatcher : in out Handler;
Virtual_Hostname : String;
Action : Response.Callback);
-- Idem as above but take a callback procedure as parameter
procedure Unregister
(Dispatcher : in out Handler;
Virtual_Hostname : String);
-- Removes Virtual_Hostname from the list of virtual hostnames to handle
procedure Register_Default_Callback
(Dispatcher : in out Handler;
Action : AWS.Dispatchers.Handler'Class);
-- Register the default callback. This will be used if no Virtual_Hostname
-- match the request.
private
-- implementation removed
end AWS.Services.Dispatchers.Virtual_Host;
13.57. AWS.Services.Download¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2005-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- This is a download manager service, can be used to avoid polluting the main
-- server slot with long downloads. A single task is used in this
-- implementation.
with AWS.Config;
with AWS.Dispatchers;
with AWS.Resources.Streams;
with AWS.Response;
with AWS.Services.Dispatchers.Linker;
with AWS.Status;
package AWS.Services.Download is
procedure Start
(Server_Dispatcher : AWS.Dispatchers.Handler'Class;
Main_Dispatcher : out Services.Dispatchers.Linker.Handler;
Max_Concurrent_Download : Positive := Config.Max_Concurrent_Download);
-- Start the download manager server. Server_Dispatcher is the dispatcher
-- for the Web server. Main_Dispatcher is the dispatcher that must be used
-- with the main server start routine. This dispatcher handles the standard
-- web server resources and the download manager ones.
-- Max_Concurrent_Download contains the number of simultaneous download
-- that can be handled, request past this limit are queued. Note that a
-- single task is used for this implementation. Using a download manager is
-- useful to avoid the standard Web server to be busy with long downloads.
procedure Stop;
-- Stop the download server, all current download are interrupted
function Build
(Request : Status.Data;
Name : String;
Resource : not null access Resources.Streams.Stream_Type'Class)
return Response.Data;
-- Queue a download request. If there is room on the download manager the
-- template page aws_download_manager_start.thtml is used to build the
-- answer otherwise the template page aws_download_manager_waiting.thtml is
-- used. Name is the resource name and will be the default name used on the
-- user side to save the file on disk. Resource is a stream on which the
-- data to be sent are read.
--
-- Templates tags description:
--
-- aws_download_manager_waiting.thtml
-- NAME the name of the resource as pass to build
-- RES_URI the resource URI unique to the download server
-- POSITION the position on the waiting queue
-- aws_download_manager_start.thtml
-- NAME the name of the resource as pass to build
-- RES_URI the resource URI unique to the download server
--
-- Note that both template pages must contain a refresh meta-tag:
--
-- <meta http-equiv="refresh" content="2">
end AWS.Services.Download;
13.58. AWS.Services.Page_Server¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2013, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- The Callback is an implementation of a simple static Web page server. It
-- will return the Web pages found in the Web server directory. If directory
-- browsing is activated, it will be possible to browse directory content if
-- the requested resource is a directory. There is two specials files that
-- are recognized:
--
-- 404.thtml The Web page returned if the requested page is
-- not found. This is a template with a single tag
-- variable named PAGE. It will be replaced by the
-- resource which was not found.
--
-- Note that on Microsoft IE this page will be
-- displayed only if the total page size is bigger
-- than 512 bytes or it includes at least one
-- image.
--
-- aws_directory.thtml The template page used for directory browsing.
-- See AWS.Services.Directory for a full description
-- of this template usage.
with AWS.Messages;
with AWS.Response;
with AWS.Status;
package AWS.Services.Page_Server is
procedure Directory_Browsing (Activated : Boolean);
-- If Activated is set to True the directory browsing facility will be
-- activated. By default this feature is not activated.
procedure Set_Cache_Control (Data : Messages.Cache_Data);
-- Set the Cache-Control header for each response given by the following
-- callback.
function Callback (Request : Status.Data) return Response.Data;
-- This is the AWS callback for the simple static Web pages server
end AWS.Services.Page_Server;
13.59. AWS.Services.Split_Pages¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded;
with AWS.Response;
with AWS.Templates;
package AWS.Services.Split_Pages is
use Ada.Strings.Unbounded;
Splitter_Error : exception;
-- This package provides an API to split a big table in multiple pages
-- using the transient Web Pages support.
type Page_Range is record
First : Positive;
Last : Natural; -- For an empty range, Last < First
end record;
type Ranges_Table is array (Positive range <>) of Page_Range;
type URI_Table is array (Positive range <>) of Unbounded_String;
type Splitter is abstract tagged limited private;
-- This is the (abstract) root class of all splitters
-- Two operations are necessary: Get_Page_Ranges and Get_Translations
-- The following tags are always defined by the Parse function; however,
-- if a splitter redefines them in Get_Translations, the new definition
-- will replace the standard one:
-- NUMBER_PAGES Number of pages generated.
-- PAGE_NUMBER Position of the current page in all pages
-- OFFSET Current table line offset real table line can be computed
-- using: @_"+"(OFFSET):TABLE_LINE_@
function Get_Page_Ranges
(This : Splitter;
Table : Templates.Translate_Set) return Ranges_Table is abstract;
-- Get_Page_Ranges is called to define the range (in lines) of each split
-- page. Note that the ranges may overlap and need not cover the full
-- table.
function Get_Translations
(This : Splitter;
Page : Positive;
URIs : URI_Table;
Ranges : Ranges_Table) return Templates.Translate_Set is abstract;
-- Get_Translations builds the translation table for use with the splitter
function Parse
(Template : String;
Translations : Templates.Translate_Set;
Table : Templates.Translate_Set;
Split_Rule : Splitter'Class;
Cached : Boolean := True) return Response.Data;
function Parse
(Template : String;
Translations : Templates.Translate_Table;
Table : Templates.Translate_Table;
Split_Rule : Splitter'Class;
Cached : Boolean := True) return Response.Data;
-- Parse the Template file and split the result in multiple pages.
-- Translations is a standard Translate_Set used for all pages. Table
-- is the Translate_Set containing data for the table to split in
-- multiple pages. This table will be analysed and according to the
-- Split_Rule, a set of transient pages will be created.
-- If Cached is True the template will be cached (see Templates_Parser
-- documentation).
-- Each Split_Rule define a number of specific tags for use in the template
-- file.
function Parse
(Template : String;
Translations : Templates.Translate_Table;
Table : Templates.Translate_Table;
Max_Per_Page : Positive := 25;
Max_In_Index : Positive := 20;
Cached : Boolean := True) return Response.Data;
-- Compatibility function with previous version of AWS.
-- Uses the Uniform_Splitter
-- Note that the Max_In_Index parameter is ignored.
-- The same effect can be achieved by using the bounded_index.thtml
-- template for displaying the index.
private
-- implementation removed
end AWS.Services.Split_Pages;
13.60. AWS.Services.Split_Pages.Alpha¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
package AWS.Services.Split_Pages.Alpha is
-- Split in (at most) 28 pages, one for empty fields, one for all fields
-- that start with a digit, and one for each different initial letter.
-- Note that leading spaces in the key field are ignored; this means that a
-- key field containing only spaces is treated as an empty field.
-- The key field is set by calling Set_Key. If no key is defined, or no
-- corresponding association is found in Table, or the association is not a
-- vector, Splitter_Error is raised.
-- The key field must be sorted, and all values must be empty or start with
-- a digit or letter (case ignored). Otherwise, Splitter_Error is raised.
-- Letters that do not appear in the key field are associated to the empty
-- string; an Href can be specified instead by calling Set_Default_Href.
--
-- Tags:
-- NEXT The href to the next page.
-- PREVIOUS The href to the previous page.
-- FIRST The href to the first page.
-- LAST The href to the last page.
-- PAGE_INDEX Position of the current page in the INDEXES_V vector
-- HREFS_V A vector tag containing a set of href to pages, or "" if
-- their is no page for the corresponding letter.
-- INDEXES_V A vector tag (synchronized with HREFS_V) containing ' '
-- and the letters 'A' .. 'Z'
--
-- HREFS_V and INDEXES_V can be used to create an index to the generated
-- pages.
Splitter_Error : exception renames Split_Pages.Splitter_Error;
type Splitter is new Split_Pages.Splitter with private;
overriding function Get_Page_Ranges
(This : Splitter;
Table : Templates.Translate_Set) return Ranges_Table;
overriding function Get_Translations
(This : Splitter;
Page : Positive;
URIs : URI_Table;
Ranges : Ranges_Table) return Templates.Translate_Set;
procedure Set_Key (This : in out Splitter; Key : String);
-- Set the key field, this is the name of the vector association in the
-- translate_set that will be used to create the index.
procedure Set_Default_Href (This : in out Splitter; Href : String);
-- Href to use for letter having no entry in the key, if not specified the
-- empty string is used.
private
-- implementation removed
end AWS.Services.Split_Pages.Alpha;
13.61. AWS.Services.Split_Pages.Alpha.Bounded¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
package AWS.Services.Split_Pages.Alpha.Bounded is
-- Same as the alpha splitter, but pages larger than Max_Per_Page are
-- further splitted.
-- A secondary index is generated that gives the various pages for a given
-- letter.
--
-- Tags (in addition to those of the alpha splitter):
-- S_NEXT The href to the next page.
-- S_PREVIOUS The href to the previous page.
-- S_FIRST The href to the first page.
-- S_LAST The href to the last page.
-- S_PAGE_INDEX Position of the current page in the S_INDEXES_V vector
-- Note that for this splitter, this is also the page number.
-- S_HREFS_V A vector tag containing a set of href to the different
-- pages for the current letter.
-- S_INDEXES_V A vector tag (synchronized with S_HREFS_V) containing the
-- page numbers for the hrefs.
--
-- HREFS_V and INDEXES_V can be used to create an index to the generated
-- pages. S_HREFS_V and S_INDEXES_V can be used to create a secondary
-- alphabetical index that points directly to the corresponding element.
type Splitter (Max_Per_Page : Positive) is new Alpha.Splitter with private;
overriding function Get_Page_Ranges
(This : Splitter;
Table : Templates.Translate_Set) return Ranges_Table;
overriding function Get_Translations
(This : Splitter;
Page : Positive;
URIs : URI_Table;
Ranges : Ranges_Table) return Templates.Translate_Set;
private
-- implementation removed
end AWS.Services.Split_Pages.Alpha.Bounded;
13.62. AWS.Services.Split_Pages.Uniform¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
package AWS.Services.Split_Pages.Uniform is
-- Split in pages of length Max_Per_Page (except the last one)
--
-- Tags:
-- NEXT The href to the next page.
-- PREVIOUS The href to the previous page.
-- FIRST The href to the first page.
-- LAST The href to the last page.
-- PAGE_INDEX Position of the current page in the INDEXES_V vector
-- Note that for this splitter, this is also the page number.
-- HREFS_V A vector tag containing a set of href to pages.
-- INDEXES_V A vector tag (synchronized with HREFS_V) containing the
-- page numbers for the hrefs.
--
-- HREFS_V and INDEXES_V can be used to create an index to the generated
-- pages.
type Splitter (Max_Per_Page : Positive) is
new Split_Pages.Splitter with private;
overriding function Get_Page_Ranges
(This : Splitter;
Table : Templates.Translate_Set) return Ranges_Table;
overriding function Get_Translations
(This : Splitter;
Page : Positive;
URIs : URI_Table;
Ranges : Ranges_Table) return Templates.Translate_Set;
private
-- implementation removed
end AWS.Services.Split_Pages.Uniform;
13.63. AWS.Services.Split_Pages.Uniform.Alpha¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
package AWS.Services.Split_Pages.Uniform.Alpha is
-- Same as the uniform splitter, but builds in addition an alphabetical
-- secondary index from a key field.
-- For the references from the index to work, each line of the @@TABLE@@
-- statement must include the following:
-- <a name="@_TABLE_LINE_@>
-- The alphabetical index will include one entry for empty fields, one
-- entry for all fields that start with a digit, and one entry for each
-- different initial letter.
-- Note that leading spaces in the key field are ignored; this means that a
-- key field containing only spaces is treated as an empty field.
-- The key field is set by calling Set_Key. If no key is defined, or no
-- corresponding association is found in Table, or the association is not a
-- vector, Splitter_Error is raised.
-- The key field must be sorted, and all values must be empty or start with
-- a digit or letter (case ignored). Otherwise, Splitter_Error is raised.
--
-- Tags (in addition to those of the uniform splitter):
-- S_HREFS_V A vector tag containing a set of href to pages in the form
-- <page>#<line>.
-- S_INDEXES_V A vector tag (synchronized with S_HREFS_V) containing
-- "<>", "0..9", and the letters 'A' .. 'Z'
--
-- HREFS_V and INDEXES_V can be used to create an index to the generated
-- pages. S_HREFS_V and S_INDEXES_V can be used to create a secondary
-- alphabetical index that points directly to the corresponding element.
Splitter_Error : exception renames Split_Pages.Splitter_Error;
type Splitter is new Uniform.Splitter with private;
overriding function Get_Page_Ranges
(This : Splitter;
Table : Templates.Translate_Set) return Ranges_Table;
overriding function Get_Translations
(This : Splitter;
Page : Positive;
URIs : URI_Table;
Ranges : Ranges_Table) return Templates.Translate_Set;
procedure Set_Key (This : in out Splitter; Key : String);
-- Set the key field, this is the name of the vector association in the
-- translate_set that will be used to create the index.
private
-- implementation removed
end AWS.Services.Split_Pages.Uniform.Alpha;
13.64. AWS.Services.Split_Pages.Uniform.Overlapping¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2004-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
package AWS.Services.Split_Pages.Uniform.Overlapping is
-- Same as the uniform splitter, but pages (except the first one)
-- repeat Overlap lines from the previous page in addition to the
-- Max_Per_Page lines
--
-- Tags:
-- Same as the Uniform splitter
type Splitter
(Max_Per_Page : Positive;
Overlap : Natural) is new Uniform.Splitter with private;
overriding function Get_Page_Ranges
(This : Splitter;
Table : Templates.Translate_Set) return Ranges_Table;
private
-- implementation removed
end AWS.Services.Split_Pages.Uniform.Overlapping;
13.65. AWS.Services.Transient_Pages¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with AWS.Config;
with AWS.Resources.Streams;
package AWS.Services.Transient_Pages is
function Get_URI return String with
Post => Get_URI'Result'Length > 0;
-- Create a unique URI, must be used to register a transient web page
procedure Register
(URI : String;
Resource : Resources.Streams.Stream_Access;
Lifetime : Duration := Config.Transient_Lifetime);
-- Register a new transient page, this page will be deleted after Lifetime
-- seconds.
function Get (URI : String) return Resources.Streams.Stream_Access;
-- Returns the stream access for the URI or null if this URI has not been
-- registered.
private
-- implementation removed
end AWS.Services.Transient_Pages;
13.66. AWS.Services.Web_Block¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2007-2013, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- Enhanced Contextual Web Framework
package AWS.Services.Web_Block with Pure is
end AWS.Services.Web_Block;
13.67. AWS.Services.Web_Block.Context¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2007-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
private with Ada.Containers.Indefinite_Hashed_Maps;
private with Ada.Strings.Hash;
private with GNAT.SHA1;
package AWS.Services.Web_Block.Context is
type Object is tagged private;
-- A context object, can be used to record key/name values
Empty : constant Object;
type Id is private;
-- An object Id, the Id depends only on the context content. Two context
-- with the very same content will have the same Id.
function Image (CID : Id) return String;
-- Returns CID string representation
function Value (CID : String) return Id;
-- Returns Id given it's string representation
function Register (Context : Object) return Id
with Post => Exist (Register'Result);
-- Register the context into the database, returns its Id
function Exist (CID : Id) return Boolean;
-- Returns True if CID context exists into the database
function Get (CID : Id) return Object;
-- Returns the context object corresponding to CID
procedure Set_Value (Context : in out Object; Name, Value : String)
with Post => Context.Exist (Name);
-- Add a new name/value pair (replace name/value if already present)
function Get_Value (Context : Object; Name : String) return String
with Post => (if not Context.Exist (Name) then Get_Value'Result = "");
-- Returns the value for the key Name or an empty string if does not exist
function Exist (Context : Object; Name : String) return Boolean;
-- Returns true if the key Name exist in this context
procedure Remove (Context : in out Object; Name : String)
with Post => not Context.Exist (Name);
-- Remove the context for key Name
generic
type Data is private;
Null_Data : Data;
package Generic_Data is
procedure Set_Value
(Context : in out Object;
Name : String;
Value : Data)
with Post => Context.Exist (Name);
-- Set key/pair value for the SID
function Get_Value (Context : Object; Name : String) return Data
with
Inline,
Post => (if not Context.Exist (Name)
then Get_Value'Result = Null_Data);
-- Returns the Value for Key in the session SID or Null_Data if
-- key does not exist.
end Generic_Data;
private
-- implementation removed
end AWS.Services.Web_Block.Context;
13.68. AWS.Services.Web_Block.Registry¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2007-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded;
with AWS.Containers.Tables;
with AWS.Messages;
with AWS.MIME;
with AWS.Response;
with AWS.Services.Web_Block.Context;
with AWS.Status;
with AWS.Templates;
package AWS.Services.Web_Block.Registry is
use Ada;
use Ada.Strings.Unbounded;
type Page is record
Content : Unbounded_String;
-- Rendered page
Content_Type : Unbounded_String;
-- The page's content type
Set : Templates.Translate_Set;
-- The translate set used to render the page
Ctx_Id : Context.Id;
-- The page context id
end record;
No_Page : constant Page;
type Data_Callback is access procedure
(Request : Status.Data;
Context : not null access Web_Block.Context.Object;
Translations : in out Templates.Translate_Set);
type Callback_Parameters is new Containers.Tables.VString_Array;
Empty_Callback_Parameters : Callback_Parameters (1 .. 0);
type Data_With_Param_Callback is access procedure
(Request : Status.Data;
Context : not null access Web_Block.Context.Object;
Parameters : Callback_Parameters;
Translations : in out Templates.Translate_Set);
type Template_Callback is access
function (Request : Status.Data) return String;
procedure Register
(Key : String;
Template : String;
Data_CB : Data_Callback;
Content_Type : String := MIME.Text_HTML;
Prefix : Boolean := False;
Context_Required : Boolean := False);
-- Key is a Lazy_Tag or template page name. Template is the corresponding
-- template file. Data_CB is the callback used to retrieve the translation
-- table to render the page. If Context_Required is True a proper context
-- must be present when rendering the page otherwise Context_Error callback
-- (see Build below) is called.
procedure Register
(Key : String;
Template_CB : Template_Callback;
Data_CB : Data_Callback;
Content_Type : String := MIME.Text_HTML;
Context_Required : Boolean := False);
-- Key is a Lazy_Tag or template page name. Template_CB is the callback
-- used to retrieve the corresponding template file name. Data_CB is the
-- callback used to retrieve the translation table to render the page.
procedure Register_Pattern_URL
(Prefix : String;
Regexp : String;
Template : String;
Data_CB : Data_With_Param_Callback;
Content_Type : String := MIME.Text_HTML;
Context_Required : Boolean := False);
-- Prefix is the prefix key to match
-- Then the rest of the url is a regular expression defined by Regexp
-- All regular-expression groups (inside parenthesis) is captured and pass
-- to the Data_CB in the Parameters vector
-- For instance, with:
-- Prefix = '/page/'
-- Regexp = '([0-9]+)/section-([a-z]+)/.*'
-- The url '/page/42/section-b/part2' will be matched and Data_CB will
-- be called with Parameters = <42, "b">
procedure Register_Pattern_URL
(Prefix : String;
Regexp : String;
Template_CB : Template_Callback;
Data_CB : Data_With_Param_Callback;
Content_Type : String := MIME.Text_HTML;
Context_Required : Boolean := False);
-- Same as above but takes a Template_Callback
function Parse
(Key : String;
Request : Status.Data;
Translations : Templates.Translate_Set;
Context : Web_Block.Context.Object := Web_Block.Context.Empty;
Context_Error : String := "") return Page;
-- Parse the Web page registered under Key. Context_Error is the key
-- of the registered template to use when a required context is not
-- present.
function Content_Type (Key : String) return String;
-- Returns the Content_Type recorded for the web object
function Build
(Key : String;
Request : Status.Data;
Translations : Templates.Translate_Set;
Status_Code : Messages.Status_Code := Messages.S200;
Cache_Control : Messages.Cache_Option := Messages.Unspecified;
Context : access Web_Block.Context.Object := null;
Context_Error : String := "") return Response.Data;
-- Same as above but returns a standard Web page. If Context is set it
-- is the initial value and will be setup at the end to correspond to
-- the recorded new context.
function Get_Context
(Request : Status.Data) return Web_Block.Context.Object;
-- Gets the proper context object for this request. Note that if the
-- context object is modified outside of the Web_Block framework it must be
-- passed to the Build or Parse procedure above.
private
-- implementation removed
end AWS.Services.Web_Block.Registry;
13.69. AWS.Session¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This is the API to handle session data for each client connected
with Ada.Calendar;
private with AWS.Config;
package AWS.Session is
use Ada;
type Id is private;
type Value_Kind is (Int, Str, Real, Bool, User);
No_Session : constant Id;
function Create return Id with
Post => Create'Result /= No_Session;
-- Create a new uniq Session Id
function Creation_Stamp (SID : Id) return Calendar.Time;
-- Returns the creation date of this session
function Private_Key (SID : Id) return String;
-- Return the private key for this session
procedure Delete (SID : Id) with
Post => not Exist (SID);
-- Delete session, does nothing if SID does not exist.
-- In most cases, the client browser will still send the cookie identifying
-- the session on its next request. In such a case, the function
-- AWS.Status.Timed_Out will return True, same as when the session was
-- deleted automatically by AWS when it expired.
-- The recommended practice is therefore to call
-- AWS.Response.Set.Clear_Session when you send a response to the customer
-- after deleting the session, so that the cookie is not sent again.
function Delete_If_Empty (SID : Id) return Boolean;
-- Delete session only if there is no key/value pairs.
-- Returns True if session deleted.
-- Need to delete not used just created session to avoid too many empty
-- session creation.
function Image (SID : Id) return String with Inline;
-- Return ID image
function Value (SID : String) return Id with Inline;
-- Build an ID from a String, returns No_Session if SID is not recongnized
-- as an AWS session ID.
function Exist (SID : Id) return Boolean;
-- Returns True if SID exist
procedure Touch (SID : Id);
-- Update to current time the timestamp associated with SID. Does nothing
-- if SID does not exist.
procedure Set (SID : Id; Key : String; Value : String);
-- Set key/value pair for the SID
procedure Set (SID : Id; Key : String; Value : Integer);
-- Set key/value pair for the SID
procedure Set (SID : Id; Key : String; Value : Float);
-- Set key/value pair for the SID
procedure Set (SID : Id; Key : String; Value : Boolean);
-- Set key/value pair for the SID
function Get (SID : Id; Key : String) return String with
Inline => True,
Post => (not Exist (SID, Key) and then Get'Result'Length = 0)
or else Exist (SID, Key);
-- Returns the Value for Key in the session SID or the emptry string if
-- key does not exist.
function Get (SID : Id; Key : String) return Integer with
Inline => True,
Post => (not Exist (SID, Key) and then Get'Result = 0)
or else Exist (SID, Key);
-- Returns the Value for Key in the session SID or the integer value 0 if
-- key does not exist or is not an integer.
function Get (SID : Id; Key : String) return Float with
Inline => True,
Post => (not Exist (SID, Key) and then Get'Result = 0.0)
or else Exist (SID, Key);
-- Returns the Value for Key in the session SID or the float value 0.0 if
-- key does not exist or is not a float.
function Get (SID : Id; Key : String) return Boolean with
Inline => True,
Post => (not Exist (SID, Key) and then Get'Result = False)
or else Exist (SID, Key);
-- Returns the Value for Key in the session SID or the boolean False if
-- key does not exist or is not a boolean.
generic
type Data is private;
Null_Data : Data;
package Generic_Data is
procedure Set (SID : Id; Key : String; Value : Data);
-- Set key/value pair for the SID
function Get (SID : Id; Key : String) return Data with Inline;
-- Returns the Value for Key in the session SID or Null_Data if
-- key does not exist.
end Generic_Data;
procedure Remove (SID : Id; Key : String) with
Post => not Exist (SID, Key);
-- Removes Key from the specified session
function Exist (SID : Id; Key : String) return Boolean;
-- Returns True if Key exist in session SID
function Server_Count return Natural;
-- Returns number of servers with sessions support
function Length return Natural;
-- Returns number of sessions
function Length (SID : Id) return Natural;
-- Returns number of key/value pairs in session SID
procedure Clear with Post => Length = 0;
-- Removes all sessions data
---------------
-- Iterators --
---------------
generic
with procedure Action
(N : Positive;
SID : Id;
Time_Stamp : Ada.Calendar.Time;
Quit : in out Boolean);
procedure For_Every_Session;
-- Iterator which call Action for every active session. N is the SID
-- order. Time_Stamp is the time when SID was updated for the last
-- time. Quit is set to False by default, it is possible to control the
-- iterator termination by setting its value to True. Note that in the
-- Action procedure it is possible to use routines that read session's
-- data (Get, Exist) but any routines which modify the data will block
-- (i.e. Touch, Set, Remove, Delete will dead lock).
generic
with procedure Action
(N : Positive;
Key, Value : String;
Kind : Value_Kind;
Quit : in out Boolean);
procedure For_Every_Session_Data (SID : Id);
-- Iterator which returns all the key/value pair defined for session SID.
-- Quit is set to False by default, it is possible to control the iterator
-- termination by setting its value to True. Note that in the Action
-- procedure it is possible to use routines that read session's data (Get,
-- Exist) but any routines which modify the data will block (i.e. Touch,
-- Set, Remove, Delete will dead lock).
--------------
-- Lifetime --
--------------
procedure Set_Lifetime (Seconds : Duration);
-- Set the lifetime for session data. At the point a session is deleted,
-- reusing the session ID makes AWS.Status.Session_Timed_Out return True.
function Get_Lifetime return Duration;
-- Get current session lifetime for session data
function Has_Expired (SID : Id) return Boolean;
-- Returns true if SID should be considered as expired (ie there hasn't
-- been any transaction on it since Get_Lifetime seconds. Such a session
-- should be deleted. Calling this function is mostly internal to AWS, and
-- sessions are deleted automatically when they expire.
----------------------
-- Session Callback --
----------------------
type Callback is access procedure (SID : Id);
-- Callback procedure called when a sesssion is deleted from the server
procedure Set_Callback (Callback : Session.Callback);
-- Set the callback procedure to call when a session is deleted from the
-- server. If Callback is Null the session's callback will be removed.
----------------
-- Session IO --
----------------
procedure Save (File_Name : String);
-- Save all sessions data into File_Name
procedure Load (File_Name : String);
-- Restore all sessions data from File_Name
private
-- implementation removed
end AWS.Session;
13.70. AWS.SMTP¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This library implement the Simple Mail Transfer Protocol. Only part of the
-- RFC 821 is covered. There is no support to send a message to a console for
-- example.
with AWS.Net;
private with Ada.Strings.Unbounded;
limited with AWS.SMTP.Authentication;
package AWS.SMTP is
Server_Error : exception;
-- Raised when an unrecoverable error is found
Reply_Code_Error : exception;
-- Raised when a reply code error is not known
Default_SMTP_Port : constant := 25;
--------------
-- Receiver --
--------------
type Receiver is private;
-- The receiver part (i.e. a server) of SMTP messages as defined in
-- RFC 821. This is the SMTP server.
function Initialize
(Server_Name : String;
Port : Positive := Default_SMTP_Port;
Secure : Boolean := False;
Family : Net.Family_Type := Net.Family_Unspec;
Credential : access constant Authentication.Credential'Class := null;
Timeout : Duration := Net.Forever)
return Receiver;
-- Create a Server composed of the Name and the Port (default SMTP port
-- is 25), this server will be used to send SMTP message.
----------------
-- Reply_Code --
----------------
type Reply_Code is range 200 .. 554;
Service_Ready : constant Reply_Code := 220;
Service_Closing : constant Reply_Code := 221;
Auth_Successful : constant Reply_Code := 235;
Requested_Action_Ok : constant Reply_Code := 250;
Provide_Watchword : constant Reply_Code := 334;
Start_Mail_Input : constant Reply_Code := 354;
Syntax_Error : constant Reply_Code := 500;
function Image (R : Reply_Code) return String;
-- Returns the reply code as a string. Raises Reply_Code_Error if R is
-- not a valid reply code.
function Name (R : Reply_Code) return String;
-- Returns the reply code reason string. Raises Reply_Code_Error if R is
-- not a valid reply code.
function Message (R : Reply_Code) return String;
-- This returns the value: Image (R) & ' ' & Name (R)
------------
-- Status --
------------
type Status is private;
function Is_Ok (Status : SMTP.Status) return Boolean with Inline;
-- Return True is status if Ok (no problem) or false if a problem has been
-- detected. This is not an error (in that case Error is raised) but a
-- warning because something wrong (but not unrecoverable) has happen.
function Status_Message (Status : SMTP.Status) return String;
-- If Is_Ok is False, this function return the reason of the problem. The
-- return message is the error message as reported by the server.
function Warnings (Status : SMTP.Status) return String with Inline;
-- Returns warnings during recipient addresses processing
function Status_Code (Status : SMTP.Status) return Reply_Code with Inline;
-- Returns the code replied by the server
procedure Clear (Status : in out SMTP.Status) with Inline;
-- Clear Status value. Code is set to Requested_Action_Ok and message
-- string to null.
-----------------
-- E_Mail_Data --
-----------------
type E_Mail_Data is private;
type Address_Mode is (Full, Name, Address);
function Image
(E_Mail : E_Mail_Data;
Mode : Address_Mode := Full) return String;
-- Returns E_Mail only (Mode = Address), recipient name only (Mode = Name)
-- or Name and e-mail (Mode = Full).
function E_Mail (Name : String; Address : String) return E_Mail_Data;
-- Returns an e-mail address
function Parse (E_Mail : String) return E_Mail_Data;
-- Parse an e-mail with format "Name <address>" or "address (Name)"
-- and Returns the corresponding E_Mail_Data. Raises Contraint_Error
-- if E_Mail can't be parsed.
type Recipients is array (Positive range <>) of E_Mail_Data;
No_Recipient : constant Recipients;
private
-- implementation removed
end AWS.SMTP;
13.71. AWS.SMTP.Client¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
--
-- This unit implements an API to send email messages. It is possible to send
-- simple email [RFC 821] and email with MIME attachments [RFC 2045 & 2049].
--
-- How to send an email:
--
-- 1) Initialize a Server to send the messages.
--
-- Wanadoo : SMTP.Receiver := SMTP.Client.Initialize ("smtp.wanadoo.fr");
--
-- Optionally, request Authentication
--
-- Auth : aliased SMTP.Authentication.Credential :=
-- SMTP.Authentication.Plain.Initialize ("id", "password");
--
-- Wanadoo : SMTP.Receiver :=
-- SMTP.Client.Initialize
-- ("smtp.wanadoo.fr", Credential => Auth'Access);
--
-- 2) Send a message via the server.
--
-- Result : SMTP.Status;
--
-- SMTP.Client.Send
-- (Server => Wanadoo,
-- From => SMTP.E_Mail ("Pascal Obry", "pascal@obry.net"),
-- To => SMTP.E_Mail
-- ("Dmitriy Anisimkov", "anisimkov@ada-ru.org"),
-- Subject => "Latest Ada news",
-- Message => "now Ada can send SMTP mail!",
-- Status => Result);
with AWS.Attachments;
package AWS.SMTP.Client is
Server_Error : exception renames SMTP.Server_Error;
function Initialize
(Server_Name : String;
Port : Positive := Default_SMTP_Port;
Secure : Boolean := False;
Family : Net.Family_Type := Net.Family_Unspec;
Credential : access constant Authentication.Credential'Class := null;
Timeout : Duration := Net.Forever)
return Receiver renames SMTP.Initialize;
procedure Send
(Server : Receiver;
From : E_Mail_Data;
To : E_Mail_Data;
Subject : String;
Message : String;
Status : out SMTP.Status;
CC : Recipients := No_Recipient;
BCC : Recipients := No_Recipient;
To_All : Boolean := True);
-- Send a message via Server. The email is a simple message composed of a
-- subject and a text message body. Raise Server_Error in case of an
-- unrecoverable error (e.g. can't contact the server).
-- If To_All is False email is sent even if some email addresses
-- in recipient list are not correct.
type Attachment is private;
-- This is an attachment object, either a File or some Base64 encoded
-- content.
-- only simple attachments are supported. For full attachment support use
-- AWS.Attachments with the corresponding Send routine below.
function File (Filename : String) return Attachment;
-- Returns a file attachment. Filename point to a file on the file system
function Base64_Data (Name, Content : String) return Attachment;
-- Returns a base64 encoded attachment. Content must already be Base64
-- encoded data. The attachment is named Name.
-- This is a way to send a file attachment from in-memory data.
type Attachment_Set is array (Positive range <>) of Attachment;
-- A set of file attachments
procedure Send
(Server : Receiver;
From : E_Mail_Data;
To : E_Mail_Data;
Subject : String;
Message : String := "";
Attachments : Attachment_Set;
Status : out SMTP.Status;
CC : Recipients := No_Recipient;
BCC : Recipients := No_Recipient;
To_All : Boolean := True);
-- Send a message via Server. The email is a MIME message composed of a
-- subject, a message and a set of MIME encoded files. Raise Server_Error
-- in case of an unrecoverable error (e.g. can't contact the server).
-- Raises Constraint_Error if a file attachment cannot be opened.
-- If To_All is False email is sent even if some email addresses in
-- recipient list are not correct.
type Message_File is new String;
procedure Send
(Server : Receiver;
From : E_Mail_Data;
To : E_Mail_Data;
Subject : String;
Filename : Message_File;
Status : out SMTP.Status;
CC : Recipients := No_Recipient;
BCC : Recipients := No_Recipient;
To_All : Boolean := True);
-- Send filename content via Server. The email is a message composed of a
-- subject and a message body coming from a file. Raises Server_Error in
-- case of an unrecoverable error (e.g. can't contact the server). Raises
-- Constraint_Error if Filename cannot be opened.
--
-- Extentded interfaces to send a message to many recipients
--
procedure Send
(Server : Receiver;
From : E_Mail_Data;
To : Recipients;
Subject : String;
Message : String;
Status : out SMTP.Status;
CC : Recipients := No_Recipient;
BCC : Recipients := No_Recipient;
To_All : Boolean := True);
-- Send a message via Server. The mail is a simple message composed of a
-- subject and a text message body. Raise Server_Error in case of an
-- unrecoverable error (e.g. can't contact the server).
-- If To_All is False email is sent even if some email addresses
-- in recipient list are not correct.
procedure Send
(Server : Receiver;
From : E_Mail_Data;
To : Recipients;
Source : String;
Status : out SMTP.Status;
CC : Recipients := No_Recipient;
BCC : Recipients := No_Recipient;
To_All : Boolean := True);
-- Send a message via Server. The email Source has already been composed by
-- other means, such as the GNATcoll email facilities.
-- Raise Server_Error in case of an unrecoverable error, e.g. can't contact
-- the server.
-- If To_All is False email is sent even if some email addresses in
-- recipient list are not correct.
procedure Send
(Server : Receiver;
From : E_Mail_Data;
To : Recipients;
Subject : String;
Message : String := "";
Attachments : Attachment_Set;
Status : out SMTP.Status;
CC : Recipients := No_Recipient;
BCC : Recipients := No_Recipient;
To_All : Boolean := True);
-- Send a message via Server. The email is a MIME message composed of a
-- subject, a message and a set of files MIME encoded. Raise Server_Error
-- in case of an unrecoverable error (e.g. can't contact the server).
-- Raises Constraint_Error if a file attachment cannot be opened.
-- If To_All is False email is sent even if some email addresses in
-- recipient list are not correct.
procedure Send
(Server : Receiver;
From : E_Mail_Data;
To : Recipients;
Subject : String;
Attachments : AWS.Attachments.List;
Status : out SMTP.Status;
CC : Recipients := No_Recipient;
BCC : Recipients := No_Recipient;
To_All : Boolean := True);
-- As above but takes an attachment list which support complex attachments
-- like multiplart/alternative.
private
-- implementation removed
end AWS.SMTP.Client;
13.72. AWS.Status¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This package is used to keep the HTTP protocol status. Client can then
-- request the status for various values like the requested URI, the
-- Content_Length and the Session ID for example.
with Ada.Calendar;
with Ada.Real_Time;
with Ada.Streams;
with Ada.Strings.Unbounded;
with AWS.Attachments;
with AWS.Headers;
with AWS.Messages;
with AWS.Net;
with AWS.Parameters;
with AWS.Session;
with AWS.URL;
private with AWS.Resources.Streams.Memory;
private with GNAT.SHA256;
package AWS.Status is
use Ada;
use Ada.Streams;
use Ada.Strings.Unbounded;
type Data is private;
type Request_Method is
(OPTIONS, GET, HEAD, POST, PUT, DELETE, TRACE, CONNECT, EXTENSION_METHOD);
-- EXTENSION_METHOD indicates that a method is an extension-method,
-- ie none of the eight method tokens predefined in the RFC 2616.
type Authorization_Type is (None, Basic, Digest);
------------------
-- Request-Line --
------------------
function Method (D : Data) return Request_Method with Inline;
-- Returns the request method
function Method (D : Data) return String with Inline;
-- Returns the request method as a String. Useful to get the method String
-- for an extension-method, ie a method that is not already predefined
-- in the RFC 2616.
function URI (D : Data) return String with Inline;
-- Returns the requested resource
function URI (D : Data) return URL.Object with Inline;
-- As above but return an URL object
function URL (D : Data) return String with Inline;
-- Returns the requested URL
function Parameters (D : Data) return Parameters.List with Inline;
-- Returns the list of parameters for the request. This list can be empty
-- if there was no form or URL parameters.
function Parameter
(D : Data; Name : String; N : Positive := 1) return String with Inline;
function HTTP_Version (D : Data) return String with Inline;
-- Returns the HTTP version used by the client
function Request_Time (D : Data) return Calendar.Time with Inline;
-- Returns the time of the request
function Request_Time (D : Data) return Real_Time.Time with Inline;
------------
-- Header --
------------
function Header (D : Data) return Headers.List with Inline;
-- Returns the list of header lines for the request
function Accept_Encoding (D : Data) return String with Inline;
-- Get the value for "Accept-Encoding:" header
function Connection (D : Data) return String with Inline;
-- Get the value for "Connection:" header
function Content_Length (D : Data) return Stream_Element_Count with Inline;
-- Get the value for "Content-Length:" header, this is the number of
-- bytes in the message body.
function Content_Type (D : Data) return String with Inline;
-- Get value for "Content-Type:" header
function Transfer_Encoding (D : Data) return String with Inline;
-- Get value for "Transfer-Encoding:" header
function Expect (D : Data) return String with Inline;
-- Get value for "Expect:" header
function Host (D : Data) return String with Inline;
-- Get value for "Host:" header
function If_Modified_Since (D : Data) return String with Inline;
-- Get value for "If-Modified-Since:" header
function Keep_Alive (D : Data) return Boolean with Inline;
-- Returns the flag if the current HTTP connection is keep-alive
function User_Agent (D : Data) return String with Inline;
-- Get value for "User-Agent:" header
function Referer (D : Data) return String with Inline;
-- Get value for "Referer:" header
function Cache_Control (D : Data) return Messages.Cache_Option
with Inline;
-- Get value for "Cache-Control:" header
function Cache_Control (D : Data) return Messages.Cache_Data
with Inline;
-- Returns the cache control data specified for the request
function Is_Supported
(D : Data;
Encoding : Messages.Content_Encoding) return Boolean;
-- Returns True if the content encoding scheme is supported by the client
function Preferred_Coding (D : Data) return Messages.Content_Encoding;
-- Returns supported by AWS coding preferred by client from the
-- Accept-Coding header.
function Upgrade (D : Data) return String with Inline;
-- Get value for "Upgrade:" header
function Sec_WebSocket_Key (D : Data) return String with Inline;
-- Get value for "Sec-WebSocket-Key:" header
-------------------------------------------
-- Cross-Origin Resource Sharing Headers --
-------------------------------------------
function Origin (D : Data) return String with Inline;
-- Get value for "Origin:" header
function Access_Control_Request_Headers (D : Data) return String
with Inline;
-- Get value for "Access-Control-Request-Headers:" header
function Access_Control_Request_Method (D : Data) return String with Inline;
-- Get value for "Access-Control-Request-Method:" header
----------------
-- Connection --
----------------
function Peername (D : Data) return String with Inline;
-- Returns the address of the peer (the IP address of the client computer)
function Socket (D : Data) return Net.Socket_Type'Class with Inline;
-- Returns the socket used to transfer data between the client and
-- server.
function Socket (D : Data) return Net.Socket_Access with Inline;
-- Returns the socket used to transfer data between the client and
-- server. Use Socket_Access to avoid memory allocation if we would need
-- socket access further.
----------
-- Data --
----------
function Is_Body_Uploaded (D : Data) return Boolean with Inline;
-- Returns True if the message body has been uploaded and False if not.
-- The reason being that the body size is above Upload_Size_Limit.
-- User can upload the file using AWS.Server.Get_Message_Body, the size
-- being returned by Content_Length.
function Multipart_Boundary (D : Data) return String with Inline;
-- Get value for the boundary part in "Content-Type: ...; boundary=..."
-- parameter. This is a string that will be used to separate each chunk of
-- data in a multipart message.
function Binary_Data (D : Data) return Stream_Element_Array with Inline;
-- Returns the binary data message content.
-- Note that only the root part of a multipart/related message is returned.
function Binary_Data (D : Data) return Unbounded_String;
-- Returns the binary data message content in a Unbounded_String
-- Note that only the root part of a multipart/related message is returned.
function Binary_Size (D : Data) return Stream_Element_Offset with Inline;
-- Returns size of the binary data message content
procedure Reset_Body_Index (D : Data) with Inline;
-- Reset message body read position to the start
procedure Read_Body
(D : Data;
Buffer : out Stream_Element_Array;
Last : out Stream_Element_Offset)
with Inline;
-- Read a chunk of data from message body and put them into Buffer.
-- Last is the index of the last item returned in Buffer.
function End_Of_Body (D : Data) return Boolean with Inline;
-- Returns true if there is no more data to read from the message body
-----------------
-- Attachments --
-----------------
function Attachments (D : Data) return AWS.Attachments.List with Inline;
-- Returns the list of Attachments for the request
-------------
-- Session --
-------------
function Has_Session (D : Data) return Boolean with Inline;
-- Returns true if a session ID has been received
function Session_Private (D : Data) return String with Inline;
-- Returns the private Session ID for the request. Raises Constraint_Error
-- if server's session support not activated.
function Session (D : Data) return Session.Id with Inline;
-- Returns the Session ID for the request. Raises Constraint_Error if
-- server's session support not activated.
function Session_Created (D : Data) return Boolean;
-- Returns True if session was just created and is going to be sent to
-- client.
function Session_Timed_Out (D : Data) return Boolean;
-- Returns True if a previous session was timeout (even if a new session
-- has been created).
----------
-- SOAP --
----------
function Is_SOAP (D : Data) return Boolean with Inline;
-- Returns True if it is a SOAP request. In this case SOAPAction return
-- the SOAPAction header and Payload returns the XML SOAP Payload message.
function SOAPAction (D : Data) return String with Inline;
-- Get value for "SOAPAction:" parameter. This is a standard header to
-- support SOAP over HTTP protocol.
function Payload (D : Data) return String with Inline;
-- Returns the XML Payload message. XML payload is the actual SOAP
-- request. This is the root part of multipart/related SOAP message.
function Payload (D : Data) return Unbounded_String;
-- Returns the XML Payload message. XML payload is the actual SOAP
-- request. This is the root part of multipart/related SOAP message.
-----------
-- HTTPS --
-----------
function Check_Digest
(D : Data; Password : String) return Messages.Status_Code;
-- This function is used by the digest authentication to check if the
-- client password and authentication parameters are correct.
-- The password is not transferred between the client and the server,
-- the server check that the client knows the right password using the
-- MD5 checksum.
-- Returns Messages.S200 in case of successful authentication,
-- Messages.S400 in case of wrong authentication request
-- (RFC 2617 3.2.2, 3.2.2.5),
-- and Messages.S401 in case of authentication error.
function Check_Digest (D : Data; Password : String) return Boolean;
-- The same as above, but do not distinguish wrong requests and
-- authentication errors.
function Authorization_Mode (D : Data) return Authorization_Type
with Inline;
-- Returns the type of the "Authorization:" parameter
function Authorization_Name (D : Data) return String with Inline;
-- Returns "username" value in the "Authorization:" parameter
function Authorization_URI (D : Data) return String with Inline;
-- Returns "uri" value in the "Authorization:" parameter
-- Note, it could differ from HTTP URI field, for example Mozilla browser
-- places http parameters to the authorization uri field.
function Authorization_Password (D : Data) return String with Inline;
-- Returns "password" value in the "Authorization:" parameter
function Authorization_Realm (D : Data) return String with Inline;
-- Returns "realm" value in the "Authorization:" parameter
function Authorization_Nonce (D : Data) return String with Inline;
-- Returns "nonce" value in the "Authorization:" parameter
function Authorization_NC (D : Data) return String with Inline;
-- Returns "nc" value in the "Authorization:" parameter
function Authorization_CNonce (D : Data) return String with Inline;
-- Returns "cnonce" value in the "Authorization:" parameter
function Authorization_QOP (D : Data) return String with Inline;
-- Retruns "qop" value in the "Authorization:" parameter
function Authorization_Response (D : Data) return String with Inline;
-- Returns "response" value in the "Authorization:" parameter
function Authorization_Tail (D : Data) return String with Inline;
-- Returns precalculated part of digest composed of
-- Nonce, NC, CNonce, QOP, Method, URI authorization fields.
-- To build a full authorization response you can use:
--
-- MD5.Digest
-- (MD5.Digest (Username & ':' & Realm & ':' & Password)
-- & Authorization_Tail);
--
-- This method can be used to avoid sending a password over the network.
private
-- implementation removed
end AWS.Status;
13.73. AWS.Templates¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2012, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with Templates_Parser;
package AWS.Templates renames Templates_Parser;
13.74. AWS.Translator¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2019, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Streams;
with Ada.Strings.Unbounded;
with AWS.Resources.Streams.Memory.ZLib;
with AWS.Utils;
package AWS.Translator is
use Ada.Streams;
use Ada.Strings.Unbounded;
package ZL renames AWS.Resources.Streams.Memory.ZLib;
------------
-- Base64 --
------------
type Base64_Mode is (MIME, URL);
-- Base64 encoding variants for encoding routines,
-- RFC4648
-- MIME - section 4
-- URL - section 5
subtype Base64_Common is Character with
Static_Predicate => Base64_Common
in 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '=';
subtype Base64_String is String with
Dynamic_Predicate =>
(for all C of Base64_String =>
C in Base64_Common | '+' | '-' | '_' | '/');
subtype Base64_UString is Unbounded_String with
Dynamic_Predicate =>
(for all K in 1 .. Length (Base64_UString) =>
Element (Base64_UString, K)
in Base64_Common | '+' | '-' | '_' | '/');
--
-- Decoding does not have to have Base64_Mode parameter, because data
-- coding easy detected automatically.
procedure Base64_Encode
(Data : Unbounded_String;
B64_Data : out Base64_UString;
Mode : Base64_Mode := MIME)
with
Post =>
(Mode = MIME
and then
(for all K in 1 .. Length (B64_Data) =>
Element (B64_Data, K) not in '-' | '_'))
or else
(Mode = URL
and then
(for all K in 1 .. Length (B64_Data) =>
Element (B64_Data, K) not in '+' | '/'));
function Base64_Encode
(Data : Stream_Element_Array;
Mode : Base64_Mode := MIME) return Base64_String
with
Post =>
(Mode = MIME
and then
(for all C of Base64_Encode'Result => C not in '-' | '_'))
or else
(Mode = URL
and then
(for all C of Base64_Encode'Result => C not in '+' | '/'));
-- Encode Data using the base64 algorithm
function Base64_Encode
(Data : String; Mode : Base64_Mode := MIME) return Base64_String
with
Post =>
(Mode = MIME
and then
(for all C of Base64_Encode'Result => C not in '-' | '_'))
or else
(Mode = URL
and then
(for all C of Base64_Encode'Result => C not in '+' | '/'));
-- Same as above but takes a string as input
procedure Base64_Decode
(B64_Data : Base64_UString;
Data : out Unbounded_String);
function Base64_Decode
(B64_Data : Base64_String) return Stream_Element_Array;
-- Decode B64_Data using the base64 algorithm
function Base64_Decode (B64_Data : Base64_String) return String;
--------
-- QP --
--------
function QP_Decode (QP_Data : String) return String;
-- Decode QP_Data using the Quoted Printable algorithm
------------------------------------
-- String to Stream_Element_Array --
------------------------------------
function To_String
(Data : Stream_Element_Array) return String with Inline;
-- Convert a Stream_Element_Array to a string. Note that as this routine
-- returns a String it should not be used with large array as this could
-- break the stack size limit. Use the routine below for large array.
function To_Stream_Element_Array
(Data : String) return Stream_Element_Array with Inline;
-- Convert a String to a Stream_Element_Array
function To_Stream_Element_Array
(Data : String) return Utils.Stream_Element_Array_Access;
-- As above but designed to be used for large objects
function To_Unbounded_String
(Data : Stream_Element_Array) return Unbounded_String;
-- Convert a Stream_Element_Array to an Unbounded_String
--------------------------
-- Compress/Decompress --
--------------------------
subtype Compression_Level is ZL.Compression_Level;
Default_Compression : constant Compression_Level := ZL.Default_Compression;
function Compress
(Data : Stream_Element_Array;
Level : Compression_Level := Default_Compression;
Header : ZL.Header_Type := ZL.Default_Header)
return Utils.Stream_Element_Array_Access;
-- Returns Data compressed with a standard deflate algorithm based on the
-- zlib library. The result is dynamically allocated and must be
-- explicitly freed.
function Decompress
(Data : Stream_Element_Array;
Header : ZL.Header_Type := ZL.Default_Header)
return Utils.Stream_Element_Array_Access;
-- Returns Data decompressed based on the zlib library. The results is
-- dynamically allocated and must be explicitly freed.
end AWS.Translator;
13.75. AWS.URL¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2017, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Strings.Maps;
with Ada.Strings.Unbounded;
with AWS.Parameters;
package AWS.URL is
use Ada;
use Ada.Strings.Unbounded;
-- The general URL form as described in RFC2616 is:
--
-- http_URL = "http:" "//" host [ ":" port ] [ abs_path [ "?" query ]]
--
-- Note also that there are different RFC describing URL like the 2616 and
-- 1738 but they use different terminologies. Here we try to follow the
-- names used in RFC2616 but we have implemented some extensions at the
-- end of this package. For example the way Path and File are separated or
-- the handling of user/password which is explicitly not allowed in the
-- RFC but are used and supported in many browsers. Here are the extended
-- URL supported:
--
-- http://user:pass@www.here.com:80/dir1/dir2/xyz.html?p=8&x=doh#anchor
-- | | | | | | |
-- protocol host port path file parameters fragment
--
-- <-- pathname -->
type Object is private;
URL_Error : exception;
Default_FTP_Port : constant := 21;
Default_HTTP_Port : constant := 80;
Default_HTTPS_Port : constant := 443;
function Parse
(URL : String;
Check_Validity : Boolean := True;
Normalize : Boolean := False) return Object;
-- Parse an URL and return an Object representing this URL. It is then
-- possible to extract each part of the URL with the services bellow.
-- Raises URL_Error if Check_Validity is true and the URL reference a
-- resource above the web root directory.
procedure Normalize (URL : in out Object);
-- Removes all occurrences to parent directory ".." and current directory
-- ".". Raises URL_Error if the URL reference a resource above the Web
-- root directory.
function Is_Valid (URL : Object) return Boolean;
-- Returns True if the URL is valid (does not reference directory above
-- the Web root).
function URL (URL : Object) return String;
-- Returns full URL string, this can be different to the URL passed if it
-- has been normalized.
function Protocol_Name (URL : Object) return String;
-- Returns "http" or "https" depending on the protocol used by URL
function Host
(URL : Object; IPv6_Brackets : Boolean := False) return String;
-- Returns the hostname in IPv6 breakets if necessary
function Port (URL : Object) return Positive;
-- Returns the port as a positive
function Port (URL : Object) return String;
-- Returns the port as a string
function Port_Not_Default (URL : Object) return String;
-- Returns the port image (preceded by character ':') if it is not the
-- default port. Returns the empty string otherwise.
function Abs_Path
(URL : Object;
Encode : Boolean := False) return String;
-- Returns the absolute path. This is the complete resource reference
-- without the query part.
function Query
(URL : Object;
Encode : Boolean := False) return String;
-- Returns the Query part of the URL or the empty string if none was
-- specified. Note that character '?' is not part of the Query and is
-- therefore not returned.
--
-- Below are extended API not part of the RFC 2616 URL specification
--
function User (URL : Object) return String;
-- Returns user name part of the URL. Returns the empty string if user was
-- not specified.
function Password (URL : Object) return String;
-- Returns user's password part of the URL. Returns the empty string if
-- password was not specified.
function Server_Name
(URL : Object; IPv6_Brackets : Boolean := False) return String
renames Host;
function Security (URL : Object) return Boolean;
-- Returns True if it is a Secure HTTP (HTTPS) URL
function Path (URL : Object; Encode : Boolean := False) return String;
-- Returns the Path (including the leading slash). If Encode is True then
-- the URL will be encoded using the Encode routine.
function File (URL : Object; Encode : Boolean := False) return String;
-- Returns the File. If Encode is True then the URL will be encoded using
-- the Encode routine. Not that by File here we mean the latest part of
-- the URL, it could be a real file or a diretory into the filesystem.
-- Parent and current directories are part of the path.
function Parameters
(URL : Object;
Encode : Boolean := False) return String;
-- Returns the Parameters (including the starting ? character). If Encode
-- is True then the URL will be encoded using the Encode routine.
function Pathname
(URL : Object;
Encode : Boolean := False) return String renames Abs_Path;
function Pathname_And_Parameters
(URL : Object;
Encode : Boolean := False) return String;
-- Returns the pathname and the parameters. This is equivalent to:
-- Pathname & Parameters.
function Parameter
(URL : Object; Name : String; N : Positive := 1) return String
with Inline;
-- Returns the Nth value associated with Key into Table. Returns
-- the emptry string if key does not exist.
function Parameters (URL : Object) return AWS.Parameters.List with Inline;
-- Return the parameter list associated with the URL
function Fragment (URL : Object) return String with Inline;
-- Return the part after the # sign (included)
--
-- URL Resolution
--
function Resolve (URL : Object; Base_URL : Object) return Object;
-- Resolve an URL relative to a Base_URL. Uses RFC 3986, section 5.2
-- algorithm.
function Resolve (URL : String; Base_URL : String) return String;
-- Resolve an URL relatively to a Base_URL. Same function as above, but
-- working with Strings.
--
-- URL Encoding and Decoding
--
Parameters_Encoding_Set : constant Strings.Maps.Character_Set;
-- Encoding set enought for HTTP parameters
Default_Encoding_Set : constant Strings.Maps.Character_Set;
-- Encoding set enought for all URL parts
function Encode
(Str : String;
Encoding_Set : Strings.Maps.Character_Set := Default_Encoding_Set)
return String;
-- Encode Str into a URL-safe form. Many characters are forbiden into an
-- URL and needs to be encoded. A character is encoded by %XY where XY is
-- the character's ASCII hexadecimal code. For example a space is encoded
-- as %20.
function Decode (Str : String) return String;
-- This is the opposite of Encode above
function Decode (Str : Unbounded_String) return Unbounded_String;
private
-- implementation removed
end AWS.URL;
13.76. SOAP¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2018, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
package SOAP is
-- This is the root package for the SOAP implementation. It supports
-- SOAP 1.1 specifications.
SOAP_Error : exception;
-- Will be raised when an error occurs in the SOAP implementation. The
-- exception message will described the problem.
Version : constant String := "3.0.0";
-- Version number for this implementation
No_SOAPAction : constant String := (1 => ASCII.NUL);
-- Value used to specify that there was no SOAPAction specified
end SOAP;
13.77. SOAP.Client¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with AWS.Client;
with SOAP.Message.Payload;
with SOAP.Message.Response;
with SOAP.WSDL.Schema;
package SOAP.Client is
Not_Specified : String renames AWS.Client.No_Data;
function Call
(URL : String;
P : Message.Payload.Object;
SOAPAction : String := No_SOAPAction;
User : String := Not_Specified;
Pwd : String := Not_Specified;
Proxy : String := Not_Specified;
Proxy_User : String := Not_Specified;
Proxy_Pwd : String := Not_Specified;
Timeouts : AWS.Client.Timeouts_Values := AWS.Client.No_Timeout;
Asynchronous : Boolean := False;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty)
return Message.Response.Object'Class
with Pre => URL'Length > 0;
-- Send a SOAP HTTP request to URL address. The P is the Payload and
-- SOAPAction is the required HTTP field. If it is not specified then the
-- URI (URL resource) will be used for the SOAPAction field. The complete
-- format is "URL & '#' & Procedure_Name" (Procedure_Name is retrieved
-- from the Payload object.
--
-- If Asynchronous is set to True the response from the server may be
-- empty. In this specific case the success of the call depends on the
-- HTTP status code.
function Call
(Connection : AWS.Client.HTTP_Connection;
SOAPAction : String;
P : Message.Payload.Object;
Asynchronous : Boolean := False;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty)
return Message.Response.Object'Class
with Pre => AWS.Client.Host (Connection)'Length > 0;
-- Idem as above, but use an already opened connection
end SOAP.Client;
13.78. SOAP.Dispatchers¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Dispatcher for SOAP requests
with AWS.Dispatchers;
with AWS.Response;
with AWS.Status;
with SOAP.Message.Payload;
with SOAP.WSDL.Schema;
package SOAP.Dispatchers is
type Handler is abstract new AWS.Dispatchers.Handler with private;
-- This dispatcher will send SOAP and HTTP requests to different routines
function Schema
(Dispatcher : Handler;
SOAPAction : String)
return WSDL.Schema.Definition;
-- Returns the schema for the given SOAPAction
type SOAP_Callback is
access function (SOAPAction : String;
Payload : Message.Payload.Object;
Request : AWS.Status.Data)
return AWS.Response.Data;
-- This is the SOAP Server callback type. SOAPAction is the HTTP header
-- SOAPAction value, Payload is the parsed XML payload, request is the
-- HTTP request status.
function Dispatch_SOAP
(Dispatcher : Handler;
SOAPAction : String;
Payload : Message.Payload.Object;
Request : AWS.Status.Data)
return AWS.Response.Data is abstract;
-- This dispatch function is called for SOAP requests
function Dispatch_HTTP
(Dispatcher : Handler;
Request : AWS.Status.Data)
return AWS.Response.Data is abstract;
-- This dispatch function is called for standard HTTP requests
private
-- implementation removed
end SOAP.Dispatchers;
13.79. SOAP.Dispatchers.Callback¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2003-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
-- Dispatch on a SOAP Callback procedures
with SOAP.Message;
with SOAP.WSDL.Schema;
package SOAP.Dispatchers.Callback is
type Handler is new Dispatchers.Handler with private;
-- This is a simple wrapper around standard callback procedure (access to
-- function). It will be used to build dispatchers services and for the
-- main server callback.
overriding function Schema
(Dispatcher : Handler;
SOAPAction : String)
return WSDL.Schema.Definition;
function Create
(HTTP_Callback : AWS.Response.Callback;
SOAP_Callback : Dispatchers.SOAP_Callback;
Schema : WSDL.Schema.Definition :=
WSDL.Schema.Empty) return Handler;
-- Build a dispatcher for the specified callback
private
-- implementation removed
end SOAP.Dispatchers.Callback;
13.80. SOAP.Message¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
with Ada.Strings.Unbounded;
with SOAP.Name_Space;
with SOAP.Parameters;
with SOAP.WSDL.Schema;
package SOAP.Message is
use Ada.Strings.Unbounded;
type Object is tagged private;
function XML_Image
(M : Object;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty)
return Unbounded_String;
-- Returns the XML image for the wrapper and parameters. This is designed
-- to be used by Payload and Response object.
function Name_Space (M : Object'Class) return SOAP.Name_Space.Object;
-- Returns message Namespace
function Wrapper_Name (M : Object'Class) return String;
-- Returns wrapper name
function Parameters (M : Object'Class) return SOAP.Parameters.List;
-- Returns the parameter
procedure Set_Name_Space
(M : in out Object'Class;
NS : SOAP.Name_Space.Object);
-- Set message's Namespace
procedure Set_Wrapper_Name
(M : in out Object'Class;
Name : String);
-- Set message's wrapper name
procedure Set_Parameters
(M : in out Object'Class;
P_Set : SOAP.Parameters.List);
-- Set message's parameters
private
-- implementation removed
end SOAP.Message;
13.81. SOAP.Message.XML¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2015, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with AWS.Client;
with SOAP.Message.Payload;
with SOAP.Message.Response;
with SOAP.WSDL.Schema;
package SOAP.Message.XML is
SOAP_Error : exception renames SOAP.SOAP_Error;
function Load_Payload
(XML : aliased String;
Envelope : Boolean := True;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty)
return Message.Payload.Object;
-- Build a Payload object by parsing the XML payload string.
-- If Envelope is False, the message could consists only from body
-- with arbitrary named root tag without mandatory SOAP Envelope wrapper.
function Load_Payload
(XML : Unbounded_String;
Envelope : Boolean := True;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty)
return Message.Payload.Object;
-- Build a Payload object by parsing the XML payload string
function Load_Response
(Connection : AWS.Client.HTTP_Connection;
Envelope : Boolean := True;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty)
return Message.Response.Object'Class;
-- Build a Response object (either a standard response or an error
-- response) by parsing the HTTP client connection output.
-- If Envelope is False, the message could consists only from body
-- with arbitrary named root tag without mandatory SOAP Envelope wrapper.
function Load_Response
(XML : aliased String;
Envelope : Boolean := True;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty)
return Message.Response.Object'Class;
-- Build a Response object (either a standard response or an error
-- response) by parsing the XML response string.
-- If Envelope is False, the message could consists only from body
-- with arbitrary named root tag without mandatory SOAP Envelope wrapper.
function Load_Response
(XML : Unbounded_String;
Envelope : Boolean := True;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty)
return Message.Response.Object'Class;
-- As above but using an Unbounded_String
function Image
(O : Object'Class;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty) return String;
-- Returns XML representation of object O
function Image
(O : Object'Class;
Schema : WSDL.Schema.Definition :=
WSDL.Schema.Empty) return Unbounded_String;
-- Idem as above but returns an Unbounded_String instead of a String
end SOAP.Message.XML;
13.82. SOAP.Parameters¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2000-2014, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
with Ada.Calendar;
with Ada.Strings.Unbounded;
with SOAP.Types;
package SOAP.Parameters is
use Ada.Strings.Unbounded;
Data_Error : exception renames Types.Data_Error;
Max_Parameters : constant := 50;
-- This is the maximum number of parameters supported by this
-- implementation.
type List is private;
function Argument_Count (P : List) return Natural with
Post => Argument_Count'Result <= Max_Parameters;
-- Returns the number of parameters in P
function Argument (P : List; Name : String) return Types.Object'Class;
-- Returns parameters named Name in P. Raises Types.Data_Error if not
-- found.
function Argument (P : List; N : Positive) return Types.Object'Class;
-- Returns Nth parameters in P. Raises Types.Data_Error if not found
function Exist (P : List; Name : String) return Boolean;
-- Returns True if parameter named Name exist in P and False otherwise
function Get (P : List; Name : String) return Types.Long with Inline;
-- Returns parameter named Name in P as a Long value. Raises
-- Types.Data_Error if this parameter does not exist or is not a Long.
function Get (P : List; Name : String) return Integer with Inline;
-- Returns parameter named Name in P as an Integer value. Raises
-- Types.Data_Error if this parameter does not exist or is not an Integer.
function Get (P : List; Name : String) return Types.Short with Inline;
-- Returns parameter named Name in P as a Short value. Raises
-- Types.Data_Error if this parameter does not exist or is not an Short.
function Get (P : List; Name : String) return Types.Byte with Inline;
-- Returns parameter named Name in P as a Byte value. Raises
-- Types.Data_Error if this parameter does not exist or is not a Byte.
function Get (P : List; Name : String) return Float with Inline;
-- Returns parameter named Name in P as a Float value. Raises
-- Types.Data_Error if this parameter does not exist or is not a Float.
function Get (P : List; Name : String) return Long_Float with Inline;
-- Returns parameter named Name in P as a Float value. Raises
-- Types.Data_Error if this parameter does not exist or is not a Double.
function Get (P : List; Name : String) return String with Inline;
-- Returns parameter named Name in P as a String value. Raises
-- Types.Data_Error if this parameter does not exist or is not a String.
function Get (P : List; Name : String) return Unbounded_String with Inline;
-- Idem as above, but return an Unbounded_String
function Get (P : List; Name : String) return Boolean with Inline;
-- Returns parameter named Name in P as a Boolean value. Raises
-- Types.Data_Error if this parameter does not exist or is not a Boolean.
function Get (P : List; Name : String) return Ada.Calendar.Time with Inline;
-- Returns parameter named Name in P as a Time value. Raises
-- Types.Data_Error if this parameter does not exist or is not a time.
function Get (P : List; Name : String) return Types.Unsigned_Long
with Inline;
-- Returns parameter named Name in P as a Unsigned_Long value. Raises
-- Types.Data_Error if this parameter does not exist or is not an
-- Unsigned_Long.
function Get (P : List; Name : String) return Types.Unsigned_Int
with Inline;
-- Returns parameter named Name in P as a Unsigned_Int value. Raises
-- Types.Data_Error if this parameter does not exist or is not an
-- Unsigned_Int.
function Get (P : List; Name : String) return Types.Unsigned_Short
with Inline;
-- Returns parameter named Name in P as a Unsigned_Short value. Raises
-- Types.Data_Error if this parameter does not exist or is not an
-- Unsigned_Short.
function Get (P : List; Name : String) return Types.Unsigned_Byte
with Inline;
-- Returns parameter named Name in P as a Unsigned_Byte value. Raises
-- Types.Data_Error if this parameter does not exist or is not an
-- Unsigned_Byte.
function Get (P : List; Name : String) return Types.SOAP_Base64 with Inline;
-- Returns parameter named Name in P as a SOAP Base64 value. Raises
-- Types.Data_Error if this parameter does not exist or is not a SOAP
-- Base64.
function Get (P : List; Name : String) return Types.SOAP_Record with Inline;
-- Returns parameter named Name in P as a SOAP Struct value. Raises
-- Types.Data_Error if this parameter does not exist or is not a SOAP
-- Struct.
function Get (P : List; Name : String) return Types.SOAP_Array with Inline;
-- Returns parameter named Name in P as a SOAP Array value. Raises
-- Types.Data_Error if this parameter does not exist or is not a SOAP
-- Array.
------------------
-- Constructors --
------------------
function "&" (P : List; O : Types.Object'Class) return List with
Post => Argument_Count ("&"'Result) = Argument_Count (P) + 1;
function "+" (O : Types.Object'Class) return List with
Post => Argument_Count ("+"'Result) = 1;
----------------
-- Validation --
----------------
procedure Check (P : List; N : Natural);
-- Checks that there is exactly N parameters or raise Types.Data_Error
procedure Check_Integer (P : List; Name : String);
-- Checks that parameter named Name exist and is an Integer value
procedure Check_Float (P : List; Name : String);
-- Checks that parameter named Name exist and is a Float value
procedure Check_Boolean (P : List; Name : String);
-- Checks that parameter named Name exist and is a Boolean value
procedure Check_Time_Instant (P : List; Name : String);
-- Checks that parameter named Name exist and is a Time_Instant value
procedure Check_Base64 (P : List; Name : String);
-- Checks that parameter named Name exist and is a Base64 value
procedure Check_Null (P : List; Name : String);
-- Checks that parameter named Name exist and is a Null value
procedure Check_Record (P : List; Name : String);
-- Checks that parameter named Name exist and is a Record value
procedure Check_Array (P : List; Name : String);
-- Checks that parameter named Name exist and is an Array value
private
-- implementation removed
end SOAP.Parameters;
13.83. SOAP.Types¶
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2001-2019, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under terms of the GNU General Public License as published by the --
-- Free Software Foundation; either version 3, or (at your option) any --
-- later version. This library 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. --
-- --
-- As a special exception under Section 7 of GPL version 3, you are --
-- granted additional permissions described in the GCC Runtime Library --
-- Exception, version 3.1, as published by the Free Software Foundation. --
-- --
-- You should have received a copy of the GNU General Public License and --
-- a copy of the GCC Runtime Library Exception along with this program; --
-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
-- <http://www.gnu.org/licenses/>. --
-- --
-- As a special exception, if other files instantiate generics from this --
-- unit, or you link this unit with other files to produce an executable, --
-- this unit does not by itself cause the resulting executable to be --
-- covered by the GNU General Public License. This exception does not --
-- however invalidate any other reasons why the executable file might be --
-- covered by the GNU Public License. --
------------------------------------------------------------------------------
pragma Ada_2012;
-- This package contains all SOAP types supported by this implementation.
-- Here are some notes about adding support for a new SOAP type (not a
-- container) and the corresponding WSDL support:
--
-- 1. Add new type derived from scalar in this package. Implements all
-- inherited routines (Image, XML_Image and XML_Type). Implements also
-- a constructor for this new type and a routine named V to get the
-- value as an Ada type.
--
-- 2. In SOAP.Parameters add corresponding Get routine.
--
-- 3. In SOAP.WSDL, add the new type name in Parameter_Type.
--
-- 4. Add support for this new type in all SOAP.WSDL routines. All routines
-- are using a case statement to be sure that it won't compile without
-- fixing it first. For obvious reasons, only SOAP.WSDL.To_Type and
-- SOAP.WSDL.From_Ada are not using a case statement, be sure to do the
-- right Change There.
--
-- 5. Finaly add support for this type in SOAP.Message.XML. Add this type
-- into Type_State, write the corresponding parse procedure and fill entry
-- into Handlers. Again after adding the proper type into Type_State the
-- compiler will issue errors where changes are needed.
with Ada.Calendar;
with Ada.Finalization;
with Ada.Strings.Unbounded;
with SOAP.Name_Space;
with SOAP.WSDL.Schema;
package SOAP.Types is
use Ada;
use Ada.Strings.Unbounded;
subtype Encoding_Style is WSDL.Schema.Encoding_Style;
-- SOAP encoding style for the entities
Data_Error : exception;
-- Raised when a variable has not the expected type
type Object is abstract tagged private;
-- Root type for all SOAP types defined in this package
type Object_Access is access all Object'Class;
type Object_Safe_Pointer is tagged private;
-- A safe pointer to a SOAP object, such objects are controlled so the
-- memory is freed automatically.
type Object_Set is array (Positive range <>) of Object_Safe_Pointer;
-- A set of SOAP types. This is used to build arrays or records. We use
-- Positive for the index to have the item index map the SOAP array
-- element order.
Empty_Object_Set : constant Object_Set;
function Image (O : Object) return String;
-- Returns O value image
function Is_Empty (O : Object) return Boolean;
-- Returns True if the object is empty Array, Empty Record or null value
procedure XML_Image
(O : Object;
Result : in out Unbounded_String;
Encoding : Encoding_Style := WSDL.Schema.Encoded;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty);
-- Returns O value encoded for use by the Payload object or Response
-- object. The generated characters are appened to Result.
function XML_Image (O : Object'Class) return String;
-- Returns O value encoded for use by the Payload object or Response
-- object.
function XML_Type (O : Object) return String;
-- Returns the XML type for the object
function Name (O : Object'Class) return String;
-- Returns name for object O
function Type_Name (O : Object'Class) return String;
-- Returns the type name for object O
function "+" (O : Object'Class) return Object_Safe_Pointer;
-- Allocate an object into the heap and return a safe pointer to it
function "-" (O : Object_Safe_Pointer) return Object'Class;
-- Returns the object associated with the safe pointer
type Scalar is abstract new Object with private;
-- Scalar types are using a by-copy semantic
type Composite is abstract new Object with private;
-- Composite types are using a by-reference semantic for efficiency
-- reason. Not that these types are not thread safe.
function V (O : Composite) return Object_Set;
overriding function Is_Empty (O : Composite) return Boolean;
--------------
-- Any Type --
--------------
XML_Any_Type : aliased constant String := "xsd:anyType";
type XSD_Any_Type is new Object with private;
overriding function XML_Type (O : XSD_Any_Type) return String;
overriding function Image (O : XSD_Any_Type) return String;
overriding procedure XML_Image
(O : XSD_Any_Type;
Result : in out Unbounded_String;
Encoding : Encoding_Style := WSDL.Schema.Encoded;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty);
function Any
(V : Object'Class;
Name : String := "item";
Type_Name : String := "";
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Any_Type;
function V (O : XSD_Any_Type) return Object_Access;
-----------
-- Array --
-----------
XML_Array : constant String := "soapenc:Array";
XML_Undefined : aliased constant String := "xsd:ur-type";
type SOAP_Array is new Composite with private;
overriding function Image (O : SOAP_Array) return String;
overriding procedure XML_Image
(O : SOAP_Array;
Result : in out Unbounded_String;
Encoding : Encoding_Style := WSDL.Schema.Encoded;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty);
function A
(V : Object_Set;
Name : String;
Type_Name : String := "";
NS : Name_Space.Object := Name_Space.No_Name_Space)
return SOAP_Array;
-- Type_Name of the array's elements, if not specified it will be computed
-- based on element's name.
function Size (O : SOAP_Array) return Natural;
-- Returns the number of item into the array
function V (O : SOAP_Array; N : Positive) return Object'Class;
-- Returns SOAP_Array item at position N
----------
-- Set --
----------
type SOAP_Set is new Composite with private;
-- A set is like an array but to record multi-occurence of parameters. The
-- SOAP message does not contain the enclosing SOAP array XML tag.
overriding function Image (O : SOAP_Set) return String;
overriding procedure XML_Image
(O : SOAP_Set;
Result : in out Unbounded_String;
Encoding : Encoding_Style := WSDL.Schema.Encoded;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty);
function Set
(V : Object_Set;
Name : String;
Type_Name : String := "";
NS : SOAP.Name_Space.Object := SOAP.Name_Space.No_Name_Space)
return SOAP_Set;
-- Type_Name of the array's elements, if not specified it will be computed
-- based on element's name.
------------
-- Base64 --
------------
XML_Base64 : aliased constant String := "soapenc:base64";
XML_Base64_Binary : aliased constant String := "xsd:base64Binary";
type SOAP_Base64 is new Scalar with private;
overriding function Image (O : SOAP_Base64) return String;
function B64
(V : String;
Name : String := "item";
Type_Name : String := XML_Base64;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return SOAP_Base64;
function V (O : SOAP_Base64) return String;
-------------
-- Boolean --
-------------
XML_Boolean : aliased constant String := "xsd:boolean";
type XSD_Boolean is new Scalar with private;
overriding function Image (O : XSD_Boolean) return String;
function B
(V : Boolean;
Name : String := "item";
Type_Name : String := XML_Boolean;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Boolean;
function V (O : XSD_Boolean) return Boolean;
----------
-- Byte --
----------
type Byte is range -2**7 .. 2**7 - 1;
XML_Byte : aliased constant String := "xsd:byte";
type XSD_Byte is new Scalar with private;
overriding function Image (O : XSD_Byte) return String;
function B
(V : Byte;
Name : String := "item";
Type_Name : String := XML_Byte;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Byte;
function V (O : XSD_Byte) return Byte;
------------
-- Double --
------------
XML_Double : aliased constant String := "xsd:double";
type XSD_Double is new Scalar with private;
overriding function Image (O : XSD_Double) return String;
function D
(V : Long_Float;
Name : String := "item";
Type_Name : String := XML_Double;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Double;
function V (O : XSD_Double) return Long_Float;
-----------
-- Float --
-----------
XML_Float : aliased constant String := "xsd:float";
type XSD_Float is new Scalar with private;
overriding function Image (O : XSD_Float) return String;
function F
(V : Float;
Name : String := "item";
Type_Name : String := XML_Float;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Float;
function V (O : XSD_Float) return Float;
-------------
-- Integer --
-------------
XML_Int : aliased constant String := "xsd:int";
type XSD_Integer is new Scalar with private;
overriding function Image (O : XSD_Integer) return String;
function I
(V : Integer;
Name : String := "item";
Type_Name : String := XML_Int;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Integer;
function V (O : XSD_Integer) return Integer;
----------
-- Long --
----------
type Long is range -2**63 .. 2**63 - 1;
XML_Long : aliased constant String := "xsd:long";
type XSD_Long is new Scalar with private;
overriding function Image (O : XSD_Long) return String;
function L
(V : Long;
Name : String := "item";
Type_Name : String := XML_Long;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Long;
function V (O : XSD_Long) return Long;
----------
-- Null --
----------
type XSD_Null is new Scalar with private;
overriding procedure XML_Image
(O : XSD_Null;
Result : in out Unbounded_String;
Encoding : Encoding_Style := WSDL.Schema.Encoded;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty);
function N
(Name : String;
Type_Name : String;
NS : SOAP.Name_Space.Object := SOAP.Name_Space.No_Name_Space)
return XSD_Null;
overriding function Is_Empty (O : XSD_Null) return Boolean;
------------
-- Record --
------------
type SOAP_Record is new Composite with private;
overriding function Image (O : SOAP_Record) return String;
overriding procedure XML_Image
(O : SOAP_Record;
Result : in out Unbounded_String;
Encoding : Encoding_Style := WSDL.Schema.Encoded;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty);
function R
(V : Object_Set;
Name : String;
Type_Name : String := "";
NS : Name_Space.Object := Name_Space.No_Name_Space)
return SOAP_Record;
-- If Type_Name is omitted then the type name is the name of the record.
-- Type_Name must be specified for item into an array for example.
function V (O : SOAP_Record; Name : String) return Object'Class;
-- Returns SOAP_Record field named Name
function V (O : SOAP_Record; Name : String) return Object_Set;
-- Returns SOAP_Record fields named Name
function Exists (O : SOAP_Record; Field_Name : String) return Boolean;
-- Returns True if the record O constains Field_Name
-----------
-- Short --
-----------
type Short is range -2**15 .. 2**15 - 1;
XML_Short : aliased constant String := "xsd:short";
type XSD_Short is new Scalar with private;
overriding function Image (O : XSD_Short) return String;
function S
(V : Short;
Name : String := "item";
Type_Name : String := XML_Short;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Short;
function V (O : XSD_Short) return Short;
------------
-- String --
------------
XML_String : aliased constant String := "xsd:string";
type XSD_String is new Scalar with private;
overriding function Image (O : XSD_String) return String;
function S
(V : String;
Name : String := "item";
Type_Name : String := XML_String;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_String;
function S
(V : Unbounded_String;
Name : String := "item";
Type_Name : String := XML_String;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_String;
function V (O : XSD_String) return String;
function V (O : XSD_String) return Unbounded_String;
-----------------
-- TimeInstant --
-----------------
subtype Local_Time is Calendar.Time;
-- All times are local time. This means that a timeInstant is always
-- converted to a local time for the running host.
XML_Time_Instant : aliased constant String := "xsd:timeInstant";
XML_Date_Time : aliased constant String := "xsd:dateTime";
type XSD_Time_Instant is new Scalar with private;
overriding function Image (O : XSD_Time_Instant) return String;
function T
(V : Local_Time;
Name : String := "item";
Type_Name : String := XML_Time_Instant;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Time_Instant;
function V (O : XSD_Time_Instant) return Local_Time;
-- Returns a GMT date and time
-------------------
-- Unsigned_Long --
-------------------
type Unsigned_Long is mod 2**64;
XML_Unsigned_Long : aliased constant String := "xsd:unsignedLong";
type XSD_Unsigned_Long is new Scalar with private;
overriding function Image (O : XSD_Unsigned_Long) return String;
function UL
(V : Unsigned_Long;
Name : String := "item";
Type_Name : String := XML_Unsigned_Long;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Unsigned_Long;
function V (O : XSD_Unsigned_Long) return Unsigned_Long;
------------------
-- Unsigned_Int --
------------------
type Unsigned_Int is mod 2**32;
XML_Unsigned_Int : aliased constant String := "xsd:unsignedInt";
type XSD_Unsigned_Int is new Scalar with private;
overriding function Image (O : XSD_Unsigned_Int) return String;
function UI
(V : Unsigned_Int;
Name : String := "item";
Type_Name : String := XML_Unsigned_Int;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Unsigned_Int;
function V (O : XSD_Unsigned_Int) return Unsigned_Int;
--------------------
-- Unsigned_Short --
--------------------
type Unsigned_Short is mod 2**16;
XML_Unsigned_Short : aliased constant String := "xsd:unsignedShort";
type XSD_Unsigned_Short is new Scalar with private;
overriding function Image (O : XSD_Unsigned_Short) return String;
function US
(V : Unsigned_Short;
Name : String := "item";
Type_Name : String := XML_Unsigned_Short;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Unsigned_Short;
function V (O : XSD_Unsigned_Short) return Unsigned_Short;
-------------------
-- Unsigned_Byte --
-------------------
type Unsigned_Byte is mod 2**8;
XML_Unsigned_Byte : aliased constant String := "xsd:unsignedByte";
type XSD_Unsigned_Byte is new Scalar with private;
overriding function Image (O : XSD_Unsigned_Byte) return String;
function UB
(V : Unsigned_Byte;
Name : String := "item";
Type_Name : String := XML_Unsigned_Byte;
NS : Name_Space.Object := Name_Space.No_Name_Space)
return XSD_Unsigned_Byte;
function V (O : XSD_Unsigned_Byte) return Unsigned_Byte;
-----------------
-- Enumeration --
-----------------
type SOAP_Enumeration is new Scalar with private;
overriding function Image (O : SOAP_Enumeration) return String;
overriding procedure XML_Image
(O : SOAP_Enumeration;
Result : in out Unbounded_String;
Encoding : Encoding_Style := WSDL.Schema.Encoded;
Schema : WSDL.Schema.Definition := WSDL.Schema.Empty);
function E
(V : String;
Type_Name : String;
Name : String := "item";
NS : Name_Space.Object := Name_Space.No_Name_Space)
return SOAP_Enumeration;
function V (O : SOAP_Enumeration) return String;
---------
-- Get --
---------
-- It is possible to pass an XSD_Any_Type to all get routines below. The
-- proper value will be returned if the XSD_Any_Type is actually of this
-- type.
function Get (O : Object'Class) return XSD_Any_Type;
-- Returns O value as an XSD_Any_Type. Raises Data_Error if O is not a
-- SOAP anyType.
function Get (O : Object'Class) return Long;
-- Returns O value as a Long. Raises Data_Error if O is not a SOAP
-- Long.
function Get (O : Object'Class) return Integer;
-- Returns O value as an Integer. Raises Data_Error if O is not a SOAP
-- Integer.
function Get (O : Object'Class) return Short;
-- Returns O value as a Short. Raises Data_Error if O is not a SOAP
-- Short.
function Get (O : Object'Class) return Byte;
-- Returns O value as a Byte. Raises Data_Error if O is not a SOAP
-- Byte.
function Get (O : Object'Class) return Float;
-- Returns O value as a Long_Float. Raises Data_Error if O is not a SOAP
-- Float.
function Get (O : Object'Class) return Long_Float;
-- Returns O value as a Long_Long_Float. Raises Data_Error if O is not a
-- SOAP Double.
function Get (O : Object'Class) return String;
-- Returns O value as a String. Raises Data_Error if O is not a SOAP
-- String.
function Get (O : Object'Class) return Unbounded_String;
-- As above but returns an Unbounded_String
function Get (O : Object'Class) return Boolean;
-- Returns O value as a Boolean. Raises Data_Error if O is not a SOAP
-- Boolean.
function Get (O : Object'Class) return Local_Time;
-- Returns O value as a Time. Raises Data_Error if O is not a SOAP
-- Time.
function Get (O : Object'Class) return Unsigned_Long;
-- Returns O value as a Unsigned_Long. Raises Data_Error if O is not a SOAP
-- Unsigned_Long.
function Get (O : Object'Class) return Unsigned_Int;
-- Returns O value as a Unsigned_Byte. Raises Data_Error if O is not a SOAP
-- Unsigned_Int.
function Get (O : Object'Class) return Unsigned_Short;
-- Returns O value as a Unsigned_Short. Raises Data_Error if O is not a
-- SOAP Unsigned_Short.
function Get (O : Object'Class) return Unsigned_Byte;
-- Returns O value as a Unsigned_Byte. Raises Data_Error if O is not a SOAP
-- Unsigned_Byte.
function Get (O : Object'Class) return SOAP_Base64;
-- Returns O value as a SOAP Base64. Raises Data_Error if O is not a SOAP
-- Base64 object.
function Get (O : Object'Class) return SOAP_Record;
-- Returns O value as a SOAP Struct. Raises Data_Error if O is not a SOAP
-- Struct.
function Get (O : Object'Class) return SOAP_Array;
-- Returns O value as a SOAP Array. Raises Data_Error if O is not a SOAP
-- Array.
----------------
-- Name space --
----------------
procedure Set_Name_Space
(O : in out Object'Class;
NS : Name_Space.Object);
-- Set the name space for object O
function Name_Space (O : Object'Class) return Name_Space.Object;
-- Returns name space associated with object O
procedure Rename (O : in out Object'Class; Name : String);
-- Set the name to the object
function Rename (O : Object'Class; Name : String) return Object'Class;
-- Return the same object with changed name
private
-- implementation removed
end SOAP.Types;