File : adagio-g2-upload_client.adb
------------------------------------------------------------------------------
-- ADAGIO - ADALID - AENEA. --
-- --
-- Copyright (C) 2003 --
-- A. Mosteo. --
-- --
-- Authors: A. Mosteo. (adagio@mosteo.com) --
-- --
-- If you have any questions in regard to this software, please address --
-- them to the above email. --
-- --
-- This program 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 program 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. --
-- --
-- You are not allowed to use any part of this code to develop a program --
-- whose output would be used to harass or prosecute other users of the --
-- networks Adagio connects with. All data collected with Adagio or a tool --
-- containing Adagio code about other network users must remain --
-- confidential and cannot be made public by any mean, nor be used to --
-- harass or legally prosecute these users. --
------------------------------------------------------------------------------
-- $Id: adagio-g2-upload_client.adb,v 1.12 2004/02/24 15:26:10 Jano Exp $
with Adagio.Connect.Peer;
with Adagio.Connect.Peer_manager;
with Adagio.File;
with Adagio.G2.Browse_peer;
with Adagio.G2.Chat_factory;
with Adagio.G2.Mesh;
with Adagio.G2.Meshes;
with Adagio.G2.Mesh_element;
with Adagio.Globals.Options;
with Adagio.Guid;
with Adagio.Http.Header.Response;
with Adagio.Library;
with Adagio.Misc;
with Adagio.Security;
with Adagio.Socket;
with Adagio.Socket.IP;
with Adagio.Trace;
with Adagio.Upload.Resource.Factory;
with Adagio.Upload.Resource.File;
with Strings.Fields;
with Strings.Utils;
with TigerTree;
with Aws.Url;
with ada.Calendar;
with Ada.Real_time; use Ada;
with Ada.Tags; use Ada.Tags;
with Ada.Unchecked_deallocation;
package body Adagio.G2.Upload_client is
procedure Free is new Unchecked_deallocation (
Stream_element_array, Stream_array_access);
function V (This : in Upload.Resource.Handle) return
Upload.Resource.Object_access renames Upload.Resource.V;
Min_poll : constant := 15;
Poll_window : Duration renames Globals.Options.Uploads_QueuePollWindow;
Wait_queued : Duration := 4.0;
Num_alt_locations : Natural renames Globals.Options.G2_AltLocations;
------------------------------------------------------------------------
-- Parse for alternates --
------------------------------------------------------------------------
-- Add any alt-locations to the mesh as unverified.
procedure Parse_for_alternates (This : in Object; Src : in String) is
use Strings.Fields;
begin
if Src = "" then
return;
end if;
for N in 1 .. Count_fields (Src, ',') loop
G2.Mesh.Object.Add (
G2.Mesh_element.Create (
Upload.Resource.Id (Upload.Resource.V (This.Resource).all),
Select_field (Select_field (Src, N, ','), 3, '/'),
Verified => false));
-- Trace.Log ("Adding Alt-Locations:");
-- Trace.Log ("Key : " &
-- Upload.Resource.Id (Upload.Resource.V (This.Resource)));
-- Trace.Log ("Value: " &
-- Select_field (Select_field (Src, N, ','), 3, '/'));
end loop;
exception
when E : others =>
Trace.Log ("G2.Upload_client.Parse_alternates: " &
Trace.Report (E) & " for " & Src);
end Parse_for_alternates;
------------------------------------------------------------------------
-- Create_pushed --
------------------------------------------------------------------------
-- Creation with push pending.
-- Receives simply a connected socket with pending push to be sent
-- The new object is allocated in the heap.
function Create_pushed (Addr : in Socket.Sock_addr_type)
return Upload.Client.Object_access is
This : Object_access := new Object;
begin
Socket.Create_stream (This.Socket);
Socket.Set_blocking_io (This.Socket, false);
This.Status := Push_pending;
This.Id := U (Socket.Image (Addr.Addr));
Connection :
begin
Socket.Connect (
This.Socket, Socket.Image (Addr.Addr), Natural (Addr.Port));
exception
when E : Socket.Socket_error =>
case Socket.Get_error (E) is
when Socket.Operation_would_block =>
null; -- OK
when others =>
Socket.Close (This.Socket);
raise;
end case;
end Connection;
return Upload.Client.Object_access (This);
exception
when others =>
if This /= null then
Upload.Client.Free (Upload.Client.Object_access (This));
end if;
raise;
end Create_pushed;
------------------------------------------------------------------------
-- Create --
------------------------------------------------------------------------
-- Creation regular. Headers are waiting to be read.
-- The new object is allocated in the heap.
function Create (Sock : in Socket.Object)
return Upload.Client.Object_access is
This : Object_access := new Object;
begin
This.Socket := Sock;
Socket.Set_blocking_io (This.Socket, false);
This.Status := Handshaking;
This.Id :=
U (Socket.Image (Socket.Get_peer_name (This.Socket).Addr));
This.Link := Stream_access (Socket.Stream (This.Socket));
return Upload.Client.Object_access (This);
exception
when others =>
if This /= null then
Socket.Close (This.Socket);
Upload.Client.Free (Upload.Client.Object_access (This));
end if;
raise;
end Create;
------------------------------------------------------------------------
-- Push_speed --
------------------------------------------------------------------------
procedure Push_speed (
This : in out Object;
Sent : in File_size) is
use Ada.Calendar;
Now : Calendar.Time := Clock;
begin
Average_speeds.Push (This.Avg_speed,
(Sent => Sent, Time => Now - This.Last_sent));
This.Last_sent := Now;
end Push_speed;
------------------------------------------------------------------------
-- Process --
------------------------------------------------------------------------
-- Do whatever processing the queued client needs.
-- This function is invoked periodically.
procedure Process (
This : in out Object;
Context : in Upload.Client.Queue_context; -- Info for the client
Result : out Upload.Client.Client_results -- Info for the queue
) is
use Real_time;
use type File.Object;
----------
-- Push --
----------
procedure Push is
Response : Http.Header.Set;
use type Socket.Error_type;
begin
Http.Header.Set_response (Response, "PUSH guid:" &
Guid.To_hex (Guid.My_guid));
-- Connection failed?
if (not Socket.Is_alive (This.Socket)) or else
Socket.Connection_failed (This.Socket)
then
Cancel (This);
Raise_exception (Adagio.Upload.Client.Connection_lost'Identity,
"Can't connect (pushing)");
return;
elsif not Socket.Is_writable (This.Socket) then
return;
else
This.Link := Stream_access (Socket.Stream (This.Socket));
begin
Http.Header.Write (Response, This.Link.all);
-- Push done, step to handshake
This.Status := Handshaking;
exception
when E : Socket.Socket_error =>
if Socket.Get_error (E) = Socket.Operation_would_block then
return;
else
raise;
end if;
end;
end if;
end Push;
-- Handshake --
procedure Handshake is
begin
begin
Http.Header.Parser.Check (This.Headers, This.Socket);
exception
when Socket.Socket_error =>
if This.Is_done then
Result.Is_done := true;
return;
else
raise;
end if;
end;
if Http.Header.Parser.Completed (This.Headers) then
Result.Is_done := false;
Http.Header.Parser.Get_headers (This.Headers, This.Request);
Trace.Log ("G2.Upload_client: Request_received:");
Trace.Log (Http.Header.Write (This.Request));
This.Name := U (Http.Header.Get (This.Request, "User-Agent"));
if Http.Header.Get (This.Request, "X-Nick") /= "" then
This.Nick :=
U (Strings.Utils.Trim (Aws.Url.Decode (
Http.Header.Get (This.Request, "X-Nick"))));
end if;
This.Listen := U (Http.Header.Get (This.Request, "Listen-IP"));
-- Verify user-agent bans:
if Security.Is_banned (S (This.Name)) then
Trace.Log ("Rejecting User-Agent (banning enforced): " &
S (This.Name), Trace.Debug);
Raise_exception (Upload.Client.User_agent_is_banned'Identity,
"User-Agent: " & S (This.Name));
end if;
-- Verify
declare
use Strings.Fields;
use Strings.Utils;
Response : String := Http.Header.Get_response (This.Request);
Action : String := Select_field (Response, 1);
begin
if Action /= "GET" then
-- Look for something else
-- CHAT
if Action = "CHAT" then
declare
P : Connect.Peer.Object_access;
begin
P := Connect.Peer.Object_access (
G2.Chat_Factory.Create (
S (Globals.Options.Chat_answer),
This.Socket,
This.Request));
begin
Connect.Peer_manager.Object.Add (P);
exception
when others =>
Connect.Peer.Free (P);
raise;
end;
end;
This.Reroute := true;
Result.Is_done := true;
return;
else
Trace.Log ("G2.Upload_client.Handshake: " &
"Unknown request: " & Response);
Raise_exception (Upload.Client.Unknown_request'Identity,
"Request: " & Response);
end if;
elsif Response = "GET / HTTP/1.1" then
-- Browse host
declare
P : Connect.Peer.Object_access;
begin
P := Connect.Peer.Object_access (
G2.Browse_peer.Create (This.Socket, This.Request));
begin
Connect.Peer_manager.Object.Add (P);
exception
when others =>
Connect.Peer.Free (P);
raise;
end;
end;
This.Reroute := true;
Result.Is_done := true;
return;
end if;
-- Search requested resource:
begin
This.Resource :=
Upload.Resource.Create (
Upload.Resource.Factory.Create (Response));
exception
when Upload.Resource.Unavailable =>
Trace.Log ("G2.Upload_client.Process.Handshake:" &
" Requested resource not found: " & Response);
This.Status := Rejecting;
return;
when Upload.Resource.Unknown =>
Trace.Log ("G2.Upload_client.Process.Handshake:" &
" Unknown request: " & Response, Trace.Warning);
This.Status := Rejecting;
return;
when Upload.Resource.Malformed_request =>
Trace.Log ("G2.Upload_client.Process.Handshake:" &
" Malformed request: " & Response, Trace.Warning);
This.Status := Rejecting;
return;
when E : others =>
Trace.Log ("G2.Upload_client.Process.Handshake: " &
Trace.Report (E), Trace.Warning);
This.Status := Rejecting;
return;
end;
end;
-- Alternate sources
if Use_mesh then
Parse_for_alternates (This,
Http.Header.Get (This.Request, "Alt-Location"));
Parse_for_alternates (This,
Http.Header.Get (This.Request, "X-Alt-Location"));
Parse_for_alternates (This,
Http.Header.Get (
This.Request, "X-Gnutella-Alternate-Location"));
end if;
-- Step to deliberations of queue manager:
This.Status := Waiting_queuing;
Result.Awakening := Clock;
Trace.Log ("Received request for " &
Upload.Resource.Name (V (This.Resource).all), Trace.Debug);
end if;
end;
----------------------
-- Queue resolution --
procedure Queue_resolution is
Response : Http.Header.Set;
Sent : File_size := 0;
Partial : Boolean := Http.Header.Get (This.Request, "Range") /= "";
Wait : Natural := Natural'Max (Min_poll, Min_poll +
Natural'Min (120 - Min_poll, Context.Position * 2));
PollMax : Natural := Wait + Natural (Poll_window);
Queuable : Boolean :=
Http.Header.Get (This.Request, "X-Queue") /= "";
function Get_start return File_size is
use Strings.Fields;
Start : File_size := File_size'Value (
Select_field (Select_field (
Http.Header.Get (This.Request, "Range"), 2, '='), 1, '-'));
begin
return Start + 1;
exception
when Constraint_error =>
return 1;
end Get_start;
use type Calendar.Time;
begin
Http.Header.Clear (Response);
if Context.Must_start then
if Partial then
Http.Header.Set_response (Response, "HTTP/1.1 206 OK");
else
Http.Header.Set_response (Response, "HTTP/1.1 200 OK");
end if;
Http.Header.Add (Response, "Connection", "Keep-Alive");
Result.Awakening := Clock + To_time_span (Minimum_send_delay);
-- Create headers related with ranges:
Http.Header.Response.Create_response (
Response,
This.Request,
Upload.Resource.Size (V (This.Resource).all));
This.Remaining_size := File_size'Value (
Http.Header.Get (Response, "Content-Length"));
This.Next_to_send := Get_start;
if Partial then
declare
R : Upload.Resource.Object_access := V (This.Resource);
begin
Upload.Resource.Set_position (R.all, Natural (Get_start));
end;
end if;
Upload.Resource.Stream (
V (This.Resource).all,
Upload.Resource.Stream_access (This.Source));
else
if Queuable then
Http.Header.Set_response (Response, "HTTP/1.1 503 Queued");
Http.Header.Add (Response, "Connection", "Keep-Alive");
Http.Header.Add (Response, "X-Queue",
"position=" & Misc.To_string (Context.Position) & "," &
"length=" & Misc.To_string (Context.Current_slots) & "," &
"pollMin=" & Misc.To_string (Wait) & "," &
"pollMax=" & Misc.To_string (PollMax));
Result.Awakening := Clock + To_time_span (Wait_queued);
This.nextPollMin := Calendar.Clock + Duration (Wait);
This.NextPollMax := Calendar.Clock + Duration (PollMax);
else
Http.Header.Set_response (Response, "HTTP/1.1 503 Busy");
end if;
Http.Header.Add (Response, "Content-Length", "0");
end if;
-- HTTP/1.1 headers:
Http.Header.Add (Response, "Server",
User_agent & " (Shareaza compatible)");
Http.Header.Add (Response, "X-Network", "G1, G2");
Http.Header.Add (Response, "Accept-Range", "bytes");
Http.Header.Add (Response, "Content-Type",
Upload.Resource.Content_type (
Upload.Resource.V (This.Resource).all));
if Upload.Resource.V (This.Resource)'Tag =
Upload.Resource.File.Object'Tag
then
Http.Header.Add (Response, "X-TigerTree-Path",
"/gnutella/tigertree/v3?urn:tree:tiger/:" &
TigerTree.To_base32 (File.TTH (
Upload.Resource.File.File (
Upload.Resource.File.Object_access (
Upload.Resource.V (This.Resource)).all))));
end if;
-- ALT-LOCATIONS
-- We report public locations or private-to-private
if Use_mesh and then Num_alt_locations > 0 then
declare
E : Meshes.Element_array :=
Mesh.Object.Get (
Upload.Resource.Id (V (This.Resource).all),
Num_alt_locations);
A : Ustring;
Public : Boolean := Socket.IP.Is_public (
Socket.Image (Socket.Get_peer_name (This.Socket)));
Prev : Boolean := false;
begin
for N in E'Range loop
if Socket.IP.Is_public (
Mesh_element.Location (E (N))) or else
not Public
then
if Prev then
ASU.Append (A, ", ");
end if;
ASU.Append (A, "http://");
ASU.Append (A, Mesh_element.Location (E (N)));
ASU.Append (A, "/uri-res/N2R?");
ASU.Append (A, Mesh_element.Key (E (N)));
Prev := true;
end if;
end loop;
declare
Alt : String := S (A);
begin
if Alt /= "" then
Http.Header.Add (Response, "Alt-Location", Alt);
end if;
end;
end;
end if;
-- DISABLED: I don't like this Gnutella method.
-- I'll implement it only if someday I add G1 support.
-- if not Misc.Contains (Misc.To_lower (Name (This)), "shareaza") then
-- Http.Header.Add (Response, "X-Thex-URI",
-- "/gnutella/thex/v1?urn:tree:tiger/:" &
-- TigerTree.To_base32 (File.TTH (This.File)));
-- end if;
begin
Http.Header.Write (
Response,
This.Link.all,
Send_response => true,
Send_crlf => true);
Trace.Log ("G2.Upload_client.Queue_resolution: Sent");
Trace.Log (Http.Header.Write (Response));
Sent := Http.Header.Write (Response)'Length + 2;
if Context.Must_start then
This.Status := Uploading;
This.Last_sent := Calendar.Clock;
-- Add as alternate source:
if Use_mesh and then S (This.Listen) /= "" then
G2.Mesh.Object.Add (
G2.Mesh_element.Create (
Upload.Resource.Id (
Upload.Resource.V (This.Resource).all),
S (This.Listen),
Verified => true));
end if;
elsif Queuable then
Http.Header.Parser.Reset (This.Headers);
This.Status := Queued;
else
This.Status := Done;
Result.Is_done := true;
return;
end if;
exception
when E : Socket.Socket_error =>
case Socket.Get_error (E) is
when Socket.Operation_would_block =>
Trace.Log ("G2.Upload_client.Queue_resolution: " &
"Headers delayed, link full", Trace.Warning);
when others =>
raise;
end case;
when others =>
raise;
end;
Result.Is_done := false;
Result.Sent := Sent;
Result.Received := 0;
end Queue_resolution;
------------
-- Upload --
procedure Upload is
-- Remaining to be sent in this processing:
Remaining : File_size := File_size'Min (
This.Remaining_size + This.Buffer_ava,
File_size (Context.Allowed_up));
Chunk : File_size;
Start : Time := Clock;
Elapsed : Time_span;
begin
Result.Is_uploading := true;
loop
-- Exit when no more to write.
exit when
Remaining = 0 or
This.Buffer_ava + This.Remaining_size = 0;
-- Check connection:
if not Socket.Is_alive (This.Socket) then
Cancel (This);
Raise_exception (Adagio.Upload.Client.Connection_lost'Identity,
"Client dropped connection");
return;
end if;
if not Socket.Is_writable (This.Socket) then
Push_speed (This, Result.Sent);
Result.Awakening := Clock + To_time_span (0.3);
-- Result.Awakening := Clock + To_time_span (Minimum_send_delay);
-- Trace.Log ("G2.Upload_client: Sending deferred (link full): "
-- & Adagio.Upload.Client.Queue_id (This));
return;
end if;
-- Refill the buffer if necessary:
if This.Buffer_ava = 0 then
if This.Buffer = null then
This.Buffer := new Stream_element_array (
1 .. Stream_element_offset (16 * 1024));
end if;
Chunk := File_size'Min (
This.Remaining_size, This.Buffer'Length);
Stream_element_array'Read (This.Source, This.Buffer (1 ..
Stream_element_offset (Chunk)));
This.Buffer_pos := 1;
This.Buffer_Ava := Chunk;
This.Remaining_size := This.Remaining_size - Chunk;
end if;
-- Calculate data to be sent
Chunk := File_size'Min (Remaining, This.Buffer_Ava);
begin
Write (This.Link.all, This.Buffer (
Stream_element_offset (This.Buffer_pos) ..
Stream_element_offset (This.Buffer_pos + Chunk) - 1));
This.Buffer_pos := This.Buffer_pos + Chunk;
This.Buffer_ava := This.Buffer_ava - Chunk;
Remaining := Remaining - Chunk;
Result.Sent := Result.Sent + Chunk;
exception
when E : Socket.Socket_error =>
case Socket.Get_error (E) is
when Socket.Operation_would_block =>
--Trace.Log (
-- "G2.Upload_client: Sending deferred (link error): "
-- & Adagio.Upload.Client.Queue_id (This));
exit;
when others =>
raise;
end case;
when others =>
raise;
end;
end loop;
if This.Remaining_size + This.Buffer_ava = 0 then
Http.Header.Parser.Reset (This.Headers);
Http.Header.Clear (This.Request);
This.Status := Handshaking;
This.Is_done := true;
end if;
Elapsed := Clock - Start;
if Elapsed < To_time_span (Minimum_send_delay) then
Elapsed := To_time_span (Minimum_send_delay);
end if;
Result.Awakening := Clock + Elapsed + Elapsed;
-- Speeds
Push_speed (This, Result.Sent);
end Upload;
------------------
-- Check_queued --
procedure Check_queued is
use type Ada.Calendar.Time;
begin
if not Socket.Is_alive (This.Socket) then
raise Adagio.Upload.Client.Connection_lost;
elsif Calendar.Clock < This.nextPollMin and then
Socket.Available (This.Socket) > 0
then
-- Drop, polling too fast:
raise Adagio.Upload.Client.Client_polled_too_soon;
elsif Calendar.Clock > this.nextPollMax then
-- Drop, no request within time frame:
raise Adagio.Upload.Client.Client_missed_poll_deadline;
else
Http.Header.Parser.Check (This.Headers, This.Socket);
if Http.Header.Parser.Completed (This.Headers) then
This.Status := Handshaking;
Result.Awakening := Clock;
else
Result.Awakening := Clock + To_time_span (Wait_queued);
end if;
end if;
end Check_queued;
---------------
-- Do_reject --
procedure Do_reject is
Success : Boolean;
begin
Reject (This, Adagio.Upload.Client.Unavailable, Success);
if Success then
Result.Is_done := true;
else
Result.Awakening := Clock + To_time_span (1.0);
end if;
end Do_reject;
begin
-- Defaults
Result.Is_done := false;
Result.Sent := 0;
Result.Received := 0;
Result.Awakening := Clock + To_time_span (Minimum_send_delay);
case This.Status is
when Push_pending =>
Push;
when Handshaking =>
Handshake;
when Waiting_queuing =>
Queue_resolution;
when Uploading =>
Upload;
when Queued =>
Check_queued;
when Rejecting =>
Do_reject;
when Done =>
Trace.Log (
"G2.Upload_client: Event for done client", Trace.Warning);
when others =>
raise Unimplemented;
end case;
exception
when Adagio.Upload.Client.User_agent_is_banned |
Adagio.Upload.Client.Connection_lost |
Adagio.Upload.Client.Client_polled_too_soon |
Adagio.Upload.Client.Unknown_request |
Adagio.Upload.client.Client_missed_poll_deadline |
Socket.Socket_error =>
raise;
when E : others =>
Trace.Log ("G2.Upload_client: " & Trace.Report (E), Trace.Error);
raise;
end Process;
------------------------------------------------------------------------
-- Resource --
------------------------------------------------------------------------
function Requested_resource (This : in Object) return
Upload.Resource.Handle is
begin
return This.Resource;
end Requested_resource;
------------------------------------------------------------------------
-- Id --
------------------------------------------------------------------------
-- Get an unique id for the client. Ideally should be IP independent and
-- portable across networks.
-- For G2, its the source IP:port
function Id (This : in Object) return String is
begin
return S (This.Id);
end Id;
------------------------------------------------------------------------
-- Speed --
------------------------------------------------------------------------
function Speed (This : in Object) return Float is
begin
return Average_speeds.Average (This.Avg_speed) / 1024.0;
exception
when others =>
return 0.0;
end Speed;
------------------------------------------------------------------------
-- Name --
------------------------------------------------------------------------
function Name (This : in Object) return String is
Name : constant String := S (This.Name);
Nick : constant String := S (This.Nick);
begin
if Nick = "" then
return Name;
else
return Name & " (" & Nick & ")";
end if;
end Name;
------------------------------------------------------------------------
-- Address --
------------------------------------------------------------------------
function Address (This : in Object) return String is
begin
return Socket.Image (Socket.Get_peer_name (This.Socket).Addr);
end Address;
------------------------------------------------------------------------
-- Cancel --
------------------------------------------------------------------------
-- Should close connection and free all resources.
procedure Cancel (This : in out Object) is
begin
if This.Buffer /= null then
Free (This.Buffer);
end if;
if not This.Reroute then
Socket.Close (This.Socket);
end if;
end Cancel;
------------------------------------------------------------------------
-- Finalize --
------------------------------------------------------------------------
procedure Finalize (This : in out Object) is
begin
Cancel (This);
Upload.Client.Finalize (Upload.Client.Object (This));
end Finalize;
function Add (L, R : in Chunk_speed) return Chunk_speed is
begin
return (
Sent => L.Sent + R.Sent,
Time => L.Time + R.Time);
end Add;
function Div (L : in Chunk_speed; R : in Integer) return Float is
pragma Unreferenced (R);
begin
return Float (L.Sent) / Float (L.Time);
end Div;
------------------------------------------------------------------------
-- Reject --
------------------------------------------------------------------------
procedure Reject (
This : in Object;
Reason : in Upload.Client.Reject_reason;
Done : out Boolean) is
use type Upload.Client.Reject_reason;
use type Calendar.Time;
use type Socket.Error_type;
Resp : Http.Header.Set;
begin
if Reason = Upload.Client.Busy or else
Library.Object.Count_pending_folders > 0
then
Http.Header.Set_response (Resp, "HTTP/1.1 503 Busy");
Http.Header.Add (Resp, "Retry-After", "600");
elsif Reason = Upload.Client.Unavailable then
Http.Header.Set_response (Resp, "HTTP/1.1 404 Unavailable");
else
raise Unimplemented;
end if;
if Socket.Is_alive (This.Socket) then
if Socket.Is_writable (This.Socket) then
begin
Http.Header.Write (Resp, This.Link.all, true, true);
Done := true;
exception
when E : Socket.Socket_error =>
if Socket.Get_error (E) = Socket.Operation_would_block then
Done := false;
else
raise;
end if;
when others =>
raise;
end;
else
Done := false;
end if;
else
Done := true;
end if;
end Reject;
end Adagio.G2.Upload_client;