----------------------------------------------------------------------- -- servlet-servlets -- Servlet.Core -- Copyright (C) 2010, 2011, 2012, 2013, 2015, 2016, 2017, 2018, 2020 Stephane Carrez -- Written by Stephane Carrez (Stephane.Carrez@gmail.com) -- -- Licensed under the Apache License, Version 2.0 (the "License"); -- you may not use this file except in compliance with the License. -- You may obtain a copy of the License at -- -- http://www.apache.org/licenses/LICENSE-2.0 -- -- Unless required by applicable law or agreed to in writing, software -- distributed under the License is distributed on an "AS IS" BASIS, -- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -- See the License for the specific language governing permissions and -- limitations under the License. ----------------------------------------------------------------------- with Servlet.Requests; with Servlet.Responses; with Servlet.Sessions; with Servlet.Sessions.Factory; with Servlet.Routes; limited with Servlet.Filters; with Ada.Finalization; with Ada.Strings.Unbounded; with Ada.Strings.Hash; with Ada.Calendar; with Ada.Exceptions; with Util.Log; with Util.Properties; with Util.Strings.Vectors; with EL.Contexts; private with Ada.Containers.Indefinite_Hashed_Maps; -- The Servlet.Core package implements a subset of the -- Java Servlet Specification adapted for the Ada language. -- -- The rationale for this implementation is to provide a set of -- interfaces and ways of developing a Web application which -- benefit from the architecture expertise defined in Java applications. -- -- The Servlet.Core, Servlet.Requests, Servlet.Responses -- and Servlet.Sessions packages are independent of the web server -- which will be used (such as AWS, Apache or Lighthttpd). -- package Servlet.Core is Servlet_Error : exception; type Status_Type is (Ready, Disabled, Started, Suspended, Stopped); -- Filter chain as defined by JSR 315 6. Filtering type Filter_Chain is limited private; type Filter_Config is private; type Filter_Access is access all Servlet.Filters.Filter'Class; type Filter_List_Access is access all Servlet.Filters.Filter_List; -- Causes the next filter in the chain to be invoked, or if the calling -- filter is the last filter in the chain, causes the resource at the end -- of the chain to be invoked. procedure Do_Filter (Chain : in out Filter_Chain; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Get the filter name. function Get_Filter_Name (Config : in Filter_Config) return String; -- Returns a String containing the value of the named context-wide initialization -- parameter, or the default value if the parameter does not exist. -- -- The filter parameter name is automatically prefixed by the filter name followed by '.'. function Get_Init_Parameter (Config : in Filter_Config; Name : in String; Default : in String := "") return String; function Get_Init_Parameter (Config : in Filter_Config; Name : in String; Default : in String := "") return Ada.Strings.Unbounded.Unbounded_String; -- type Servlet_Registry; type Servlet_Registry is new Servlet.Sessions.Factory.Session_Factory with private; type Servlet_Registry_Access is access all Servlet_Registry'Class; -- Get the servlet context associated with the filter chain. function Get_Servlet_Context (Chain : in Filter_Chain) return Servlet_Registry_Access; -- Get the servlet context associated with the filter config. function Get_Servlet_Context (Config : in Filter_Config) return Servlet_Registry_Access; -- The Servlet represents the component that will handle -- an HTTP request received by the server. -- -- JSR 315 - 2. The Servlet Interface type Servlet is tagged limited private; type Servlet_Access is access all Servlet'Class; -- Get the servlet name. function Get_Name (Server : in Servlet) return String; -- Get the servlet context associated with this servlet. function Get_Servlet_Context (Server : in Servlet) return Servlet_Registry_Access; -- Called by the servlet container to indicate to a servlet that the servlet -- is being placed into service. -- not overriding procedure Initialize (Server : in out Servlet; Context : in Servlet_Registry'Class); -- Receives standard HTTP requests from the public service method and dispatches -- them to the Do_XXX methods defined in this class. This method is an HTTP-specific -- version of the Servlet.service(Request, Response) method. There's no need -- to override this method. procedure Service (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Returns the time the Request object was last modified, in milliseconds since -- midnight January 1, 1970 GMT. If the time is unknown, this method returns -- a negative number (the default). -- -- Servlets that support HTTP GET requests and can quickly determine their -- last modification time should override this method. This makes browser and -- proxy caches work more effectively, reducing the load on server and network -- resources. function Get_Last_Modified (Server : in Servlet; Request : in Requests.Request'Class) return Ada.Calendar.Time; -- Called by the server (via the service method) to allow a servlet to handle -- a GET request. -- -- Overriding this method to support a GET request also automatically supports -- an HTTP HEAD request. A HEAD request is a GET request that returns no body -- in the response, only the request header fields. -- -- When overriding this method, read the request data, write the response headers, -- get the response's writer or output stream object, and finally, write the -- response data. It's best to include content type and encoding. -- When using a PrintWriter object to return the response, set the content type -- before accessing the PrintWriter object. -- -- The servlet container must write the headers before committing the response, -- because in HTTP the headers must be sent before the response body. -- -- Where possible, set the Content-Length header (with the -- Response.Set_Content_Length method), to allow the servlet container -- to use a persistent connection to return its response to the client, -- improving performance. The content length is automatically set if the entire -- response fits inside the response buffer. -- -- When using HTTP 1.1 chunked encoding (which means that the response has a -- Transfer-Encoding header), do not set the Content-Length header. -- -- The GET method should be safe, that is, without any side effects for which -- users are held responsible. For example, most form queries have no side effects. -- If a client request is intended to change stored data, the request should use -- some other HTTP method. -- -- The GET method should also be idempotent, meaning that it can be safely repeated. -- Sometimes making a method safe also makes it idempotent. For example, repeating -- queries is both safe and idempotent, but buying a product online or modifying -- data is neither safe nor idempotent. -- -- If the request is incorrectly formatted, Do_Get returns an HTTP "Bad Request" procedure Do_Get (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Receives an HTTP HEAD request from the protected service method and handles -- the request. The client sends a HEAD request when it wants to see only the -- headers of a response, such as Content-Type or Content-Length. The HTTP HEAD -- method counts the output bytes in the response to set the Content-Length header -- accurately. -- -- If you override this method, you can avoid computing the response body and just -- set the response headers directly to improve performance. Make sure that the -- Do_Head method you write is both safe and idempotent (that is, protects itself -- from being called multiple times for one HTTP HEAD request). -- -- If the HTTP HEAD request is incorrectly formatted, doHead returns an HTTP -- "Bad Request" message. procedure Do_Head (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Called by the server (via the service method) to allow a servlet to handle -- a POST request. The HTTP POST method allows the client to send data of unlimited -- length to the Web server a single time and is useful when posting information -- such as credit card numbers. -- -- When overriding this method, read the request data, write the response headers, -- get the response's writer or output stream object, and finally, write the -- response data. It's best to include content type and encoding. When using -- a PrintWriter object to return the response, set the content type before -- accessing the PrintWriter object. -- -- The servlet container must write the headers before committing the response, -- because in HTTP the headers must be sent before the response body. -- -- Where possible, set the Content-Length header (with the -- Response.Set_Content_Length method), to allow the servlet container to use -- a persistent connection to return its response to the client, improving -- performance. The content length is automatically set if the entire response -- fits inside the response buffer. -- -- When using HTTP 1.1 chunked encoding (which means that the response has a -- Transfer-Encoding header), do not set the Content-Length header. -- -- This method does not need to be either safe or idempotent. Operations -- requested through POST can have side effects for which the user can be held -- accountable, for example, updating stored data or buying items online. -- -- If the HTTP POST request is incorrectly formatted, doPost returns -- an HTTP "Bad Request" message. procedure Do_Post (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Called by the server (via the service method) to allow a servlet to handle -- a PUT request. The PUT operation allows a client to place a file on the server -- and is similar to sending a file by FTP. -- -- When overriding this method, leave intact any content headers sent with -- the request (including Content-Length, Content-Type, Content-Transfer-Encoding, -- Content-Encoding, Content-Base, Content-Language, Content-Location, -- Content-MD5, and Content-Range). If your method cannot handle a content -- header, it must issue an error message (HTTP 501 - Not Implemented) and -- discard the request. For more information on HTTP 1.1, see RFC 2616 . -- -- This method does not need to be either safe or idempotent. Operations that -- Do_Put performs can have side effects for which the user can be held accountable. -- When using this method, it may be useful to save a copy of the affected URL -- in temporary storage. -- -- If the HTTP PUT request is incorrectly formatted, Do_Put returns -- an HTTP "Bad Request" message. procedure Do_Put (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Called by the server (via the service method) to allow a servlet to handle -- a DELETE request. The DELETE operation allows a client to remove a document -- or Web page from the server. -- -- This method does not need to be either safe or idempotent. Operations requested -- through DELETE can have side effects for which users can be held accountable. -- When using this method, it may be useful to save a copy of the affected URL in -- temporary storage. -- -- If the HTTP DELETE request is incorrectly formatted, Do_Delete returns an HTTP -- "Bad Request" message. procedure Do_Delete (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Called by the server (via the service method) to allow a servlet to handle a -- OPTIONS request. The OPTIONS request determines which HTTP methods the server -- supports and returns an appropriate header. For example, if a servlet overrides -- Do_Get, this method returns the following header: -- -- Allow: GET, HEAD, TRACE, OPTIONS -- -- There's no need to override this method unless the servlet implements new -- HTTP methods, beyond those implemented by HTTP 1.1. procedure Do_Options (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Called by the server (via the service method) to allow a servlet to handle -- a TRACE request. A TRACE returns the headers sent with the TRACE request to -- the client, so that they can be used in debugging. There's no need to override -- this method. procedure Do_Trace (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Called by the server (via the service method) to allow a servlet to handle -- a PATCH request (RFC 5789). procedure Do_Patch (Server : in Servlet; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- JSR 315 9. Dispatching Requests type Request_Dispatcher is limited private; -- Forwards a request from a servlet to another resource -- (servlet, or HTML file) on the server. This method allows one servlet to do -- preliminary processing of a request and another resource to generate the response. -- -- For a Request_Dispatcher obtained via Get_Request_Dispatcher(), -- the ServletRequest object has its path elements and parameters adjusted -- to match the path of the target resource. -- -- forward should be called before the response has been committed to the -- client (before response body output has been flushed). If the response -- already has been committed, this method throws an IllegalStateException. -- Uncommitted output in the response buffer is automatically cleared before -- the forward. -- -- The request and response parameters must be either the same objects as were -- passed to the calling servlet's service method or be subclasses of the -- RequestWrapper or ResponseWrapper classes that wrap them. procedure Forward (Dispatcher : in Request_Dispatcher; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Includes the content of a resource (servlet, or, HTML file) in the response. -- In essence, this method enables programmatic server-side includes. -- -- The Response object has its path elements and parameters remain -- unchanged from the caller's. The included servlet cannot change the response -- status code or set headers; any attempt to make a change is ignored. -- -- The request and response parameters must be either the same objects as were -- passed to the calling servlet's service method or be subclasses of the -- RequestWrapper or ResponseWrapper classes that wrap them. procedure Include (Dispatcher : in Request_Dispatcher; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Returns the servlet that will be called when forwarding the request. function Get_Servlet (Dispatcher : in Request_Dispatcher) return Servlet_Access; -- Returns a Request_Dispatcher object that acts as a wrapper for the resource -- located at the given path. A Request_Dispatcher object can be used to forward -- a request to the resource or to include the resource in a response. -- The resource can be dynamic or static. function Get_Request_Dispatcher (Context : in Servlet_Registry; Path : in String) return Request_Dispatcher; -- Returns a Request_Dispatcher object that acts as a wrapper for the named servlet. -- -- Servlets may be given names via server administration or via a web application -- deployment descriptor. A servlet instance can determine its name using -- ServletConfig.getServletName(). function Get_Name_Dispatcher (Context : in Servlet_Registry; Name : in String) return Request_Dispatcher; -- Returns the context path of the web application. -- The context path is the portion of the request URI that is used to select the context -- of the request. The context path always comes first in a request URI. The path starts -- with a "/" character but does not end with a "/" character. For servlets in the default -- (root) context, this method returns "". function Get_Context_Path (Context : in Servlet_Registry) return String; -- Returns a String containing the value of the named context-wide initialization -- parameter, or null if the parameter does not exist. -- -- This method can make available configuration information useful to an entire -- "web application". For example, it can provide a webmaster's email address -- or the name of a system that holds critical data. function Get_Init_Parameter (Context : in Servlet_Registry; Name : in String; Default : in String := "") return String; function Get_Init_Parameter (Context : in Servlet_Registry; Name : in String; Default : in String := "") return Ada.Strings.Unbounded.Unbounded_String; -- Set the init parameter identified by Name to the value Value. procedure Set_Init_Parameter (Context : in out Servlet_Registry; Name : in String; Value : in String); -- Set the init parameters by copying the properties defined in Params. -- Existing parameters will be overriding by the new values. procedure Set_Init_Parameters (Context : in out Servlet_Registry; Params : in Util.Properties.Manager'Class); -- Get access to the init parameters. procedure Get_Init_Parameters (Context : in Servlet_Registry; Process : not null access procedure (Params : in Util.Properties.Manager'Class)); -- Returns the absolute path of the resource identified by the given relative path. -- The resource is searched in a list of directories configured by the application. -- The path must begin with a "/" and is interpreted as relative to the current -- context root. -- -- This method allows the servlet container to make a resource available to -- servlets from any source. -- -- This method returns an empty string if the resource could not be localized. function Get_Resource (Context : in Servlet_Registry; Path : in String) return String; -- Registers the given servlet instance with this ServletContext under -- the given servletName. -- -- If this ServletContext already contains a preliminary -- ServletRegistration for a servlet with the given servletName, -- it will be completed (by assigning the class name of the given -- servlet instance to it) and returned. procedure Add_Servlet (Registry : in out Servlet_Registry; Name : in String; Server : in Servlet_Access); -- Registers the given filter instance with this Servlet context. procedure Add_Filter (Registry : in out Servlet_Registry; Name : in String; Filter : in Filter_Access); -- Add a filter mapping with the given pattern -- If the URL pattern is already mapped to a different servlet, -- no updates will be performed. procedure Add_Filter_Mapping (Registry : in out Servlet_Registry; Pattern : in String; Name : in String); -- Add a servlet mapping with the given pattern -- If the URL pattern is already mapped to a different servlet, -- no updates will be performed. procedure Add_Mapping (Registry : in out Servlet_Registry; Pattern : in String; Name : in String); -- Add a servlet mapping with the given pattern -- If the URL pattern is already mapped to a different servlet, -- no updates will be performed. procedure Add_Mapping (Registry : in out Servlet_Registry; Pattern : in String; Server : in Servlet_Access); -- Add a route associated with the given path pattern. The pattern is split into components. -- Some path components can be a fixed string (/home) and others can be variable. -- When a path component is variable, the value can be retrieved from the route context. -- Once the route path is created, the Process procedure is called with the route -- reference. procedure Add_Route (Registry : in out Servlet_Registry; Pattern : in String; ELContext : in EL.Contexts.ELContext'Class; Process : not null access procedure (Route : in out Routes.Route_Type_Ref)); -- Set the error page that will be used if a servlet returns an error. procedure Set_Error_Page (Server : in out Servlet_Registry; Error : in Integer; Page : in String); -- Send the error page content defined by the response status. procedure Send_Error_Page (Server : in Servlet_Registry; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class); -- Report an error when an exception occurred while processing the request. procedure Error (Registry : in Servlet_Registry; Request : in out Requests.Request'Class; Response : in out Responses.Response'Class; Ex : in Ada.Exceptions.Exception_Occurrence); -- Register the application represented by Registry under the base URI defined -- by URI. This is called by the Web container when the application is registered. -- The default implementation keeps track of the base URI to implement the context path -- operation. procedure Register_Application (Registry : in out Servlet_Registry; URI : in String); -- Start the application. procedure Start (Registry : in out Servlet_Registry); -- Get the application status. function Get_Status (Registry : in Servlet_Registry) return Status_Type; -- Disable the application. procedure Disable (Registry : in out Servlet_Registry); -- Enable the application. procedure Enable (Registry : in out Servlet_Registry); -- Stop the application. procedure Stop (Registry : in out Servlet_Registry); -- Finalize the servlet registry releasing the internal mappings. overriding procedure Finalize (Registry : in out Servlet_Registry); -- Dump the routes and filter configuration in the log with the given log level. procedure Dump_Routes (Registry : in out Servlet_Registry; Level : in Util.Log.Level_Type); private use Ada.Strings.Unbounded; type Filter_Chain is limited record Filter_Pos : Natural; Filters : Filter_List_Access; Servlet : Servlet_Access; end record; type Request_Dispatcher is limited record Context : aliased Routes.Route_Context_Type; Filters : Filter_List_Access; Servlet : Servlet_Access := null; Pos : Natural := 0; end record; type Servlet is new Ada.Finalization.Limited_Controlled with record Name : Unbounded_String; Context : Servlet_Registry_Access := null; end record; package Filter_Maps is new Ada.Containers.Indefinite_Hashed_Maps (Key_Type => String, Element_Type => Filter_Access, Hash => Ada.Strings.Hash, Equivalent_Keys => "="); package Filter_List_Maps is new Ada.Containers.Indefinite_Hashed_Maps (Key_Type => String, Element_Type => Filter_List_Access, Hash => Ada.Strings.Hash, Equivalent_Keys => "="); package Servlet_Maps is new Ada.Containers.Indefinite_Hashed_Maps (Key_Type => String, Element_Type => Servlet_Access, Hash => Ada.Strings.Hash, Equivalent_Keys => "="); function Hash (N : Integer) return Ada.Containers.Hash_Type; package Error_Maps is new Ada.Containers.Indefinite_Hashed_Maps (Key_Type => Integer, Element_Type => String, Hash => Hash, Equivalent_Keys => "="); use Routes; type Servlet_Registry is new Sessions.Factory.Session_Factory with record Config : Util.Properties.Manager; Servlets : Servlet_Maps.Map; Filters : Filter_Maps.Map; Filter_Rules : Filter_List_Maps.Map; Filter_Patterns : Util.Strings.Vectors.Vector; Error_Pages : Error_Maps.Map; Context_Path : Unbounded_String; Routes : Router_Type; Status : Status_Type := Ready; end record; -- Install the servlet filters after all the mappings have been registered. procedure Install_Filters (Registry : in out Servlet_Registry); type Filter_Config is record Name : Unbounded_String; Context : Servlet_Registry_Access := null; end record; end Servlet.Core;