File : aws-response-set.adb
------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2002-2003 --
-- ACT-Europe --
-- --
-- Authors: Dmitriy Anisimkov - Pascal Obry --
-- --
-- This library is free software; you can redistribute it and/or modify --
-- it under the terms of the GNU General Public License as published by --
-- the Free Software Foundation; either version 2 of the License, or (at --
-- your option) any later version. --
-- --
-- This 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. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public License --
-- along with this library; if not, write to the Free Software Foundation, --
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. --
-- --
-- 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. --
------------------------------------------------------------------------------
-- $Id: aws-response-set.adb,v 1.1 2003/10/05 19:59:58 Jano Exp $
with AWS.Translator;
with AWS.Headers.Set;
with AWS.Digest;
package body AWS.Response.Set is
procedure Update_Data_From_Header (D : in out Data);
-- Update some Data fields from the internal Data header container.
-- The Update_Data_From_Header should be called after the complete
-- header parsing.
----------------
-- Add_Header --
----------------
procedure Add_Header
(D : in out Data;
Name : in String;
Value : in String) is
begin
Headers.Set.Add (D.Header, Name, Value);
end Add_Header;
--------------------
-- Authentication --
--------------------
procedure Authentication
(D : in out Data;
Realm : in String;
Mode : in Authentication_Mode := Basic;
Stale : in Boolean := False)
is
N : Positive := 1;
-- The index for the update of WWW-Authenticate header values.
-- We are not using AWS.Headers.Set.Add routine for add WWW-Authenticate
-- header lines, becouse user could call this routine more than once.
begin
-- In case of Authenticate = Any
-- We should create both header lines
-- WWW-Authenticate: Basic
-- and
-- WWW-Authenticate: Digest
if Mode = Digest or Mode = Any then
Headers.Set.Update
(D.Header,
Name => Messages.WWW_Authenticate_Token,
Value => "Digest qop=""auth"", realm=""" & Realm
& """, stale=""" & Boolean'Image (Stale)
& """, nonce=""" & AWS.Digest.Create_Nonce & """",
N => N);
N := N + 1;
end if;
if Mode = Basic or Mode = Any then
Headers.Set.Update
(D.Header,
Name => Messages.WWW_Authenticate_Token,
Value => "Basic realm=""" & Realm & """",
N => N);
end if;
D.Status_Code := Messages.S401;
end Authentication;
-------------------
-- Cache_Control --
-------------------
procedure Cache_Control
(D : in out Data;
Value : in Messages.Cache_Option) is
begin
Headers.Set.Update
(D.Header,
Name => Messages.Cache_Control_Token,
Value => String (Value));
end Cache_Control;
--------------------
-- Content_Length --
--------------------
procedure Content_Length
(D : in out Data;
Value : in Natural) is
begin
D.Content_Length := Value;
end Content_Length;
------------------
-- Content_Type --
------------------
procedure Content_Type
(D : in out Data;
Value : in String) is
begin
Headers.Set.Update
(D.Header,
Name => Messages.Content_Type_Token,
Value => Value);
end Content_Type;
--------------
-- Filename --
--------------
procedure Filename
(D : in out Data;
Value : in String) is
begin
D.Filename := To_Unbounded_String (Value);
D.Mode := File;
D.Content_Length := Integer (Resources.File_Size (Value));
end Filename;
--------------
-- Is_Valid --
--------------
function Is_Valid (D : in Data) return Boolean is
use type Messages.Status_Code;
Redirection_Code : Boolean;
begin
case D.Status_Code is
when
Messages.S300 | -- Section 10.3.1: Multiple Choices
Messages.S301 | -- Section 10.3.2: Moved Permanently
Messages.S302 | -- Section 10.3.3: Found
Messages.S303 | -- Section 10.3.4: See Other
Messages.S305 | -- Section 10.3.6: Use Proxy
Messages.S307 -- Section 10.3.8: Temporary Redirect
=>
Redirection_Code := True;
when others =>
Redirection_Code := False;
end case;
return (Redirection_Code
xor not Headers.Exist
(D.Header,
Messages.Location_Token))
and then (D.Status_Code = Messages.S401
xor not Headers.Exist
(D.Header,
Messages.WWW_Authenticate_Token));
end Is_Valid;
--------------
-- Location --
--------------
procedure Location
(D : in out Data;
Value : in String) is
begin
Headers.Set.Update
(D.Header,
Name => Messages.Location_Token,
Value => Value);
end Location;
------------------
-- Message_Body --
------------------
procedure Message_Body
(D : in out Data;
Value : in Streams.Stream_Element_Array) is
begin
Utils.Free (D.Message_Body);
D.Message_Body := new Streams.Stream_Element_Array'(Value);
D.Content_Length := Value'Length;
D.Mode := Message;
end Message_Body;
procedure Message_Body
(D : in out Data;
Value : in Utils.Stream_Element_Array_Access) is
begin
Utils.Free (D.Message_Body);
D.Message_Body := Value;
D.Content_Length := Value'Length;
D.Mode := Message;
end Message_Body;
procedure Message_Body
(D : in out Data;
Value : in String) is
begin
Message_Body (D, Translator.To_Stream_Element_Array (Value));
end Message_Body;
procedure Message_Body
(D : in out Data;
Value : in Strings.Unbounded.Unbounded_String) is
begin
Message_Body (D, To_String (Value));
end Message_Body;
----------
-- Mode --
----------
procedure Mode
(D : in out Data;
Value : in Data_Mode) is
begin
D.Mode := Value;
end Mode;
-----------------
-- Read_Header --
-----------------
procedure Read_Header
(Socket : in Net.Socket_Type'Class;
D : in out Data) is
begin
Headers.Set.Read (Socket, D.Header);
Update_Data_From_Header (D);
end Read_Header;
-----------------
-- Status_Code --
-----------------
procedure Status_Code
(D : in out Data;
Value : in Messages.Status_Code) is
begin
D.Status_Code := Value;
end Status_Code;
------------
-- Stream --
------------
procedure Stream
(D : in out Data;
Handle : in Resources.Streams.Stream_Access;
Content_Length : in Content_Length_Type) is
begin
D.Stream := Handle;
D.Content_Length := Content_Length;
D.Mode := Stream;
end Stream;
-----------------------------
-- Update_Data_From_Header --
-----------------------------
procedure Update_Data_From_Header (D : in out Data) is
Content_Length_Image : constant String
:= Headers.Get (D.Header, Messages.Content_Length_Token);
begin
if Content_Length_Image = "" then
D.Content_Length := Undefined_Length;
else
D.Content_Length := Content_Length_Type'Value (Content_Length_Image);
end if;
end Update_Data_From_Header;
-------------------
-- Update_Header --
-------------------
procedure Update_Header
(D : in out Data;
Name : in String;
Value : in String;
N : in Positive := 1) is
begin
Headers.Set.Update (D.Header, Name, Value, N);
end Update_Header;
end AWS.Response.Set;