------------------------------------------------------------------------------
-- 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 --
-- . --
-- --
-- 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.Characters.Handling;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Strings.Hash;
with Ada.Strings.Unbounded;
with Ada.Text_IO;
with GNAT.String_Split;
with AWS.Communication;
with AWS.Communication.Server;
with AWS.Digest;
with AWS.Messages;
with AWS.MIME;
with AWS.URL;
package body AWS.Server.Hotplug is
use Ada.Strings.Unbounded;
Authorization_Error : exception;
function Message
(Server : String;
Name : String;
Web_Server : not null access HTTP;
Parameters : Communication.Parameter_Set :=
Communication.Null_Parameter_Set)
return Response.Data;
-- Handle incoming message to register/unregister a module
package Hotplug_Server is
new Communication.Server (HTTP, HTTP_Access, Message);
type Client_Data is record
Password : Unbounded_String;
Host : Unbounded_String;
Port : Positive;
Nonce : Digest.Nonce;
end record;
package Client_Table is new Ada.Containers.Indefinite_Hashed_Maps
(String, Client_Data, Ada.Strings.Hash, "=");
Null_Nonce : constant Digest.Nonce := (others => ' ');
protected Client_Handler is
procedure Add
(Client : String;
Data : Client_Data);
-- Add this client to the list of trusted clients
procedure Get_Nonce
(Client : String;
Nonce : out Digest.Nonce);
-- Returns a new Nonce string
function Get (Client : String) return Client_Data;
-- Returns data for specified client
procedure Delete_All;
-- Removes all client from the handler
private
Clients : Client_Table.Map;
end Client_Handler;
--------------
-- Activate --
--------------
procedure Activate
(Web_Server : not null access HTTP;
Port : Positive;
Authorization_File : String;
Register_Mode : AWS.Hotplug.Register_Mode := AWS.Hotplug.Add;
Host : String := "")
is
use Ada.Characters.Handling;
use GNAT;
use type GNAT.String_Split.Slice_Number;
function "+"
(Str : String)
return Unbounded_String renames To_Unbounded_String;
File : Text_IO.File_Type;
Buffer : String (1 .. 1_024);
Last : Natural;
Line : String_Split.Slice_Set;
N : Natural := 0;
begin
Hotplug_Server.Start (Port, HTTP_Access (Web_Server), Host => Host);
AWS.Hotplug.Set_Mode (Web_Server.Filters, Register_Mode);
Text_IO.Open (File, Text_IO.In_File, Authorization_File);
while not Text_IO.End_Of_File (File) loop
Text_IO.Get_Line (File, Buffer, Last);
N := N + 1;
String_Split.Create (Line, Buffer (1 .. Last), Separators => ":");
if String_Split.Slice_Count (Line) /= 4 then
declare
Error_Message : constant String :=
Authorization_File & ": format error in line "
& Natural'Image (N);
begin
Log.Write (Web_Server.Error_Log, Error_Message);
raise Constraint_Error with Error_Message;
end;
end if;
Client_Handler.Add
(Client => String_Split.Slice (Line, 1),
Data =>
(Password => +String_Split.Slice (Line, 2),
Host => +To_Lower (String_Split.Slice (Line, 3)),
Port => Positive'Value (String_Split.Slice (Line, 4)),
Nonce => Null_Nonce));
end loop;
Text_IO.Close (File);
exception
when Text_IO.Name_Error =>
Log.Write
(Web_Server.Error_Log,
"Can't open authorization file " & Authorization_File);
end Activate;
-------------
-- Message --
-------------
function Message
(Server : String;
Name : String;
Web_Server : not null access HTTP;
Parameters : Communication.Parameter_Set :=
Communication.Null_Parameter_Set)
return Response.Data
is
pragma Unreferenced (Server);
use Ada.Characters.Handling;
function Get_Nonce (Client_Name : String) return String;
-- Returns a Nonce string
function Check_Auth
(Client_Name, Digest, Regexp : String;
URL : String := "") return Boolean;
-- Returns True if the Digest string is ok. If URL is specified, checks
-- also that this redirection is authorized.
----------------
-- Check_Auth --
----------------
function Check_Auth
(Client_Name, Digest, Regexp : String;
URL : String := "") return Boolean
is
procedure Log_Error;
-- Log an error message into the server error log file
CD : constant Client_Data := Client_Handler.Get (Client_Name);
D : AWS.Digest.Digest_String;
Result : Boolean;
---------------
-- Log_Error --
---------------
procedure Log_Error is
begin
Log.Write
(Web_Server.Error_Log,
"Wrong authorization "
& Client_Name & '|' & Regexp & '|' & URL);
end Log_Error;
begin
D := AWS.Digest.Create
(Client_Name, "hotplug",
To_String (CD.Password), String (CD.Nonce), "hotplug", Regexp);
if URL = "" then
Result := D = Digest;
return D = Digest;
else
declare
U : AWS.URL.Object;
begin
U := AWS.URL.Parse (URL);
Result := D = Digest
and then To_Lower (AWS.URL.Host (U)) = To_String (CD.Host)
and then AWS.URL.Port (U) = CD.Port;
exception
when AWS.URL.URL_Error =>
Result := False;
end;
end if;
if not Result then
Log_Error;
end if;
return Result;
end Check_Auth;
---------------
-- Get_Nonce --
---------------
function Get_Nonce (Client_Name : String) return String is
Nonce : Digest.Nonce;
begin
Client_Handler.Get_Nonce (Client_Name, Nonce);
return String (Nonce);
end Get_Nonce;
begin
-- There is two kind of message REGISTER and UNREGISTER. The formats
-- are (parameters are between <>):
--
-- REGISTER
-- UNREGISTER
-- REQUEST_NONCE
if Name = Register_Message and then Parameters'Length = 4 then
if Check_Auth
(Client_Name => To_String (Parameters (1)),
Digest => To_String (Parameters (2)),
Regexp => To_String (Parameters (3)),
URL => To_String (Parameters (4)))
then
-- Now check that the URL host for this client is authorized
AWS.Hotplug.Register
(Web_Server.Filters,
To_String (Parameters (3)),
To_String (Parameters (4)));
return Response.Acknowledge (Messages.S200, "OK");
else
return Response.Acknowledge (Messages.S401, "Wrong authorization");
end if;
elsif Name = Unregister_Message and then Parameters'Length = 3 then
if Check_Auth
(Client_Name => To_String (Parameters (1)),
Digest => To_String (Parameters (2)),
Regexp => To_String (Parameters (3)))
then
AWS.Hotplug.Unregister
(Web_Server.Filters,
To_String (Parameters (3)));
return Response.Acknowledge (Messages.S200, "OK");
else
return Response.Acknowledge (Messages.S401, "Wrong authorization");
end if;
elsif Name = Request_Nonce_Message and then Parameters'Length = 1 then
return Response.Build
(MIME.Text_Plain, Get_Nonce (To_String (Parameters (1))));
else
return Response.Acknowledge (Messages.S400, "Unknown message");
end if;
exception
when AWS.Hotplug.Register_Error =>
-- Exception sent because a duplicate client name has been found
-- on this server.
return Response.Acknowledge (Messages.S409, "Cannot register");
when Authorization_Error =>
return Response.Acknowledge (Messages.S401, "Cannot register");
end Message;
--------------------
-- Client_Handler --
--------------------
protected body Client_Handler is
---------
-- Add --
---------
procedure Add
(Client : String;
Data : Client_Data)
is
Cursor : Client_Table.Cursor;
Success : Boolean;
begin
Client_Table.Insert (Clients, Client, Data, Cursor, Success);
if not Success then
raise Authorization_Error;
end if;
end Add;
----------------
-- Delete_All --
----------------
procedure Delete_All is
begin
Client_Table.Clear (Clients);
end Delete_All;
---------
-- Get --
---------
function Get (Client : String) return Client_Data is
Cursor : Client_Table.Cursor;
begin
Cursor := Client_Table.Find (Clients, Client);
if Client_Table.Has_Element (Cursor) then
return Client_Table.Element (Cursor);
else
raise Authorization_Error;
end if;
end Get;
---------------
-- Get_Nonce --
---------------
procedure Get_Nonce
(Client : String;
Nonce : out Digest.Nonce)
is
Cursor : Client_Table.Cursor;
begin
Cursor := Client_Table.Find (Clients, Client);
if Client_Table.Has_Element (Cursor) then
declare
CD : Client_Data := Client_Table.Element (Cursor);
begin
CD.Nonce := Digest.Create_Nonce;
Nonce := CD.Nonce;
Client_Table.Replace_Element (Clients, Cursor, CD);
end;
else
raise Authorization_Error;
end if;
end Get_Nonce;
end Client_Handler;
--------------
-- Shutdown --
--------------
procedure Shutdown is
begin
Hotplug_Server.Shutdown;
Client_Handler.Delete_All;
end Shutdown;
end AWS.Server.Hotplug;