------------------------------------------------------------------------------ -- 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 -- -- . -- -- -- -- 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 Default_Moved_Message : constant String := "Page moved
Click here"; CRLF : constant String := ASCII.CR & ASCII.LF; Default_Authenticate_Message : constant String := "" & CRLF & "401 Authorization Required" & CRLF & "" & CRLF & "

Authorization Required

" & CRLF & "This server could not verify that you" & CRLF & "are authorized to access the document you" & CRLF & "requested. Either you supplied the wrong" & CRLF & "credentials (e.g. bad password), or your" & CRLF & "browser doesn't understand how to supply" & CRLF & "the credentials required.

" & CRLF & "" & CRLF; Undefined_Length : constant Content_Length_Type := Content_Length_Type (Resources.Undefined_Length); type Release_Controller is record Counter : Natural := 1; -- Data object's Reference counter Stream_Taken : Boolean := False; -- Set to True after Create_Resource routine call to not free stream -- on finalization. end record; type Release_Controller_Access is access all Release_Controller; type Data is new Ada.Finalization.Controlled with record Ref_Counter : Release_Controller_Access; Mode : Data_Mode := No_Data; Status_Code : Messages.Status_Code := Messages.S200; Filename : Unbounded_String; Content_Type : Unbounded_String; Stream : Resources.Streams.Stream_Access; Header : AWS.Headers.List; Close_Stream : Boolean := True; Keep_Alive : Boolean := True; end record; overriding procedure Initialize (Object : in out Data); overriding procedure Adjust (Object : in out Data); overriding procedure Finalize (Object : in out Data); procedure Unchecked_Free is new Ada.Unchecked_Deallocation (Resources.Streams.Stream_Type'Class, Resources.Streams.Stream_Access); end AWS.Response;