------------------------------------------------------------------------------
-- Ada Web Server --
-- --
-- Copyright (C) 2005-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 --
--
Download manager page not registered!"); end if; if Info.Position = 0 then -- Download can be started now if Info.Started then -- Let's go now, set the client side socket Info.Socket := new Net.Socket_Type'Class'(Status.Socket (Request)); Data_Manager.Update (Info); return Response.Socket_Taken; else -- Display the start page before launching the download Info.Started := True; Data_Manager.Update (Info); return Response.Build (MIME.Text_HTML, String'(Templates.Parse (S_Tmplt, (1 => Templates.Assoc ("NAME", To_String (Info.Name)), 2 => Templates.Assoc ("RES_URI", To_String (Info.R_URI)))))); end if; else return Response.Build (MIME.Text_HTML, String'(Templates.Parse (W_Tmplt, (1 => Templates.Assoc ("NAME", To_String (Info.Name)), 2 => Templates.Assoc ("RES_URI", To_String (Info.R_URI)), 3 => Templates.Assoc ("POSITION", Positive (Info.Position)))))); end if; end CB; ---------- -- Data -- ---------- protected body Data_Manager is ----------------- -- Check_Queue -- ----------------- procedure Check_Queue is use type Net.Socket_Access; begin Socket_Present := False; Check_Socket_Present : for K in 1 .. Natural (Downloads.Length) loop if Downloads.Element (K).Socket /= null then Socket_Present := True; exit Check_Socket_Present; end if; end loop Check_Socket_Present; end Check_Queue; ---------------- -- Create_Set -- ---------------- procedure Create_Set (Socket_Set : in out Sock_Set.Socket_Set_Type) is use type Net.Socket_Access; Info : Download_Information; N : Positive; begin N := Positive'Min (Max_Concurrent_Download, Positive (Downloads.Length)); for K in 1 .. N loop Info := Downloads.Element (K); if Info.Socket /= null then Sock_Set.Add (Socket_Set, Info.Socket, Sock_Set.Output); Sock_Set.Set_Data (Socket_Set, Sock_Set.Socket_Count (K), Info); end if; end loop; end Create_Set; --------- -- Get -- --------- procedure Get (URI : String; Download : out Download_Information) is use type Calendar.Time; Info : Download_Information; Index : Natural := 0; begin -- First remove old entries which have not been checked for at least -- 15 seconds. Remove_Old_Entries : while not Downloads.Is_Empty loop Info := Downloads.First_Element; if Calendar.Clock - Info.Time_Stamp > 15.0 then Downloads.Delete_First; Count := Count - 1; else exit Remove_Old_Entries; end if; end loop Remove_Old_Entries; -- Look for the given URI in the vector for K in 1 .. Natural (Downloads.Length) loop Info := Downloads.Element (K); if URI = To_String (Info.URI) then Index := K; exit; end if; end loop; if Index = 0 then -- Not found Info := No_Information; else Info.Index := Index; -- As this download was checked, update time-stamp Info.Time_Stamp := Calendar.Clock; Downloads.Replace_Element (Index, Info); if Index <= Max_Concurrent_Download then Info.Position := 0; else Info.Position := Waiting_Position (Index - Max_Concurrent_Download); end if; end if; Download := Info; Check_Queue; end Get; ------------- -- Get_UID -- ------------- procedure Get_UID (UID : out Positive) is begin Data_Manager.UID := Data_Manager.UID + 1; UID := Data_Manager.UID; end Get_UID; ----------- -- Index -- ----------- function Index (Download : Download_Information) return Positive is begin -- Use Download.Index for fast lookup, this was the original position -- for this item. The new position is either at the same index or in -- a lower position in case some downloads have endded since we got -- this item. for K in reverse 1 .. Download.Index loop if Download.URI = Downloads.Element (K).URI then return K; end if; end loop; raise Constraint_Error; end Index; ------------ -- Insert -- ------------ procedure Insert (Download : Download_Information) is begin Downloads.Append (Download); Count := Count + 1; end Insert; ----------- -- Ready -- ----------- entry Ready when Socket_Present or else Closing is begin null; end Ready; ------------- -- Release -- ------------- procedure Release is begin Downloads.Clear; Socket_Present := False; Count := 0; end Release; ------------ -- Remove -- ------------ procedure Remove (Download : Download_Information) is begin Downloads.Delete (Index (Download)); Count := Count - 1; Check_Queue; end Remove; ------------------ -- Set_Shutdown -- ------------------ procedure Set_Shutdown is begin Closing := True; end Set_Shutdown; -------------- -- Shutdown -- -------------- function Shutdown return Boolean is begin return Closing; end Shutdown; ------------ -- Update -- ------------ procedure Update (Download : Download_Information) is use type Net.Socket_Access; begin -- Set Socket_Ready status if a socket is available if Download.Socket /= null then Socket_Present := True; end if; Downloads.Replace_Element (Index (Download), Download); end Update; end Data_Manager; ---------------------- -- Download_Manager -- ---------------------- task body Download_Manager is procedure Send_Header (Socket_Set : in out Sock_Set.Socket_Set_Type; N : Sock_Set.Socket_Count; Info : in out Download_Information); -- Send HTTP headers procedure Send_Data (Info : Download_Information; Done : out Boolean); -- Send some data for Info. Done is set to true if the download is -- completed. --------------- -- Send_Data -- --------------- procedure Send_Data (Info : Download_Information; Done : out Boolean) is Buffer_Size : constant := 4 * 1_024; Buffer : Streams.Stream_Element_Array (1 .. Buffer_Size); Last : Streams.Stream_Element_Offset; begin Resources.Streams.Read (Info.Stream.all, Buffer, Last); Done := Last < Buffer'First; if not Done then Net.Buffered.Write (Info.Socket.all, Buffer (1 .. Last)); end if; end Send_Data; ----------------- -- Send_Header -- ----------------- procedure Send_Header (Socket_Set : in out Sock_Set.Socket_Set_Type; N : Sock_Set.Socket_Count; Info : in out Download_Information) is pragma Unreferenced (Socket_Set, N); Sock : constant Net.Socket_Type'Class := Info.Socket.all; begin Info.Header := True; Data_Manager.Update (Info); Net.Buffered.Put_Line (Sock, Messages.Status_Line (Messages.S200)); Net.Buffered.Put_Line (Sock, "Date: " & Messages.To_HTTP_Date (Utils.GMT_Clock)); -- Server Net.Buffered.Put_Line (Sock, "Server: AWS (Ada Web Server) v" & Version); Net.Buffered.Put_Line (Sock, Messages.Connection ("close")); Net.Buffered.Put_Line (Sock, Messages.Content_Length (Resources.Streams.Size (Info.Stream.all))); Net.Buffered.Put_Line (Sock, Messages.Content_Type (MIME.Application_Octet_Stream)); Net.Buffered.Put_Line (Sock, Messages.Content_Disposition ("attachment", To_String (Info.Name), To_String (Info.Name))); Net.Buffered.New_Line (Sock); Net.Buffered.Flush (Sock); end Send_Header; Socket_Set : Sock_Set.Socket_Set_Type; Count : Sock_Set.Socket_Count; Done : Boolean; begin Main : loop Data_Manager.Ready; exit Main when Data_Manager.Shutdown; -- Some data are ready to be sent Data_Manager.Create_Set (Socket_Set); Sock_Set.Wait (Socket_Set, Net.Forever, Count); -- For all write ready socket, send some data for K in 1 .. Sock_Set.Count (Socket_Set) loop Done := False; declare Info : Download_Information := Sock_Set.Get_Data (Socket_Set, K); begin if Sock_Set.Is_Write_Ready (Socket_Set, K) then begin if not Info.Header then Send_Header (Socket_Set, K, Info); end if; Send_Data (Info, Done); if Done then Net.Buffered.Flush (Info.Socket.all); Net.Shutdown (Info.Socket.all); end if; exception when Net.Socket_Error => Done := True; end; if Done then Resources.Streams.Close (Info.Stream.all); end if; elsif Sock_Set.Is_Error (Socket_Set, K) then Done := True; end if; if Done then -- Remove this socket from the server Data_Manager.Remove (Info); end if; end; end loop; Sock_Set.Reset (Socket_Set); end loop Main; exception when E : others => Text_IO.Put_Line (Text_IO.Current_Error, "Download manager bug detected: " & Exception_Information (E)); end Download_Manager; ----------- -- Start -- ----------- procedure Start (Server_Dispatcher : AWS.Dispatchers.Handler'Class; Main_Dispatcher : out Services.Dispatchers.Linker.Handler; Max_Concurrent_Download : Positive := Config.Max_Concurrent_Download) is begin Download.Max_Concurrent_Download := Max_Concurrent_Download; -- Set the dispatcher Dispatchers.URI.Register (DM_Handler, "/" & URI_Prefix, CB'Access, True); Dispatchers.Linker.Register (Main_Dispatcher, Server_Dispatcher, DM_Handler); -- Start download manager task DM := new Download_Manager; end Start; ---------- -- Stop -- ---------- procedure Stop is procedure Unchecked_Free is new Unchecked_Deallocation (Download_Manager, Download_Manager_Access); begin Dispatchers.URI.Unregister (DM_Handler, "/" & URI_Prefix); Data_Manager.Set_Shutdown; while not DM'Terminated loop delay 0.1; end loop; Unchecked_Free (DM); Data_Manager.Release; end Stop; end AWS.Services.Download;