1------------------------------------------------------------------------------
2--                     XML/Ada - An XML suite for Ada95                     --
3--                                                                          --
4--                     Copyright (C) 2001-2017, AdaCore                     --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24with Ada.Text_IO; use Ada.Text_IO;
25with Ada.Streams; use Ada.Streams;
26
27with GNAT.Sockets;            use GNAT.Sockets;
28
29with Unicode;
30with Unicode.CES;        use Unicode.CES;
31with Unicode.CES.Utf8;   use Unicode.CES.Utf8;
32
33package body Input_Sources.Socket is
34
35   Debug  : constant Boolean := False;
36   BUFSIZ : constant := 2048;
37
38   ----------
39   -- Open --
40   ----------
41
42   procedure Open (Socket : Socket_Type; Input : out Socket_Input) is
43      Blocking_IO_Request : Request_Type (Non_Blocking_IO);
44   begin
45      Blocking_IO_Request.Enabled := False;
46      Control_Socket (Socket, Blocking_IO_Request);
47      Input.Socket := Socket;
48      Input.Buffer := new String (1 .. BUFSIZ);
49      Input.Index := Input.Buffer'First;
50      Input.Buffer_Last := 0;
51      Input.End_Of_File := False;
52      Set_Encoding (Input, Utf8_Encoding);
53   end Open;
54
55   -----------
56   -- Close --
57   -----------
58
59   procedure Close (Input : in out Socket_Input) is
60   begin
61      Close_Socket (Input.Socket);
62      Input_Sources.Close (Input_Source (Input));
63      Input.Index := 0;
64      Input.Buffer_Last := 0;
65      Free (Input.Buffer);
66   end Close;
67
68   ---------------
69   -- Next_Char --
70   ---------------
71
72   procedure Next_Char
73     (From : in out Socket_Input; C : out Unicode.Unicode_Char)
74   is
75      procedure Update_Buffer;
76      --  Read the next stream of bytes from the socket
77
78      -------------------
79      -- Update_Buffer --
80      -------------------
81
82      procedure Update_Buffer is
83         --  There can be at most 3 bytes not processed (unfinished UTF-8 code)
84         Len         : constant Stream_Element_Count :=
85                         Stream_Element_Count
86                           (BUFSIZ - From.Buffer_Last + From.Index + 1);
87         Buffer      : Stream_Element_Array (1 .. Len);
88         Buffer_Last : Stream_Element_Count := 0;
89
90      begin
91         GNAT.Sockets.Receive_Socket (From.Socket, Buffer, Buffer_Last);
92
93         if Buffer_Last = Buffer'First - 1 then
94            From.End_Of_File := True;
95            return;
96         end if;
97
98         if From.Index <= From.Buffer_Last then
99            for A in From.Index .. From.Buffer_Last loop
100               From.Buffer (A - From.Index + 1) := From.Buffer (A);
101            end loop;
102            From.Buffer_Last := From.Buffer_Last - From.Index + 1;
103
104         else
105            From.Buffer_Last := 0;
106         end if;
107
108         From.Index := 1;
109
110         for A in 1 .. Buffer_Last loop
111            From.Buffer (From.Buffer_Last + Natural (A)) :=
112              Character'Val (Buffer (A));
113         end loop;
114
115         From.Buffer_Last := From.Buffer_Last + Natural (Buffer_Last);
116
117         if Debug then
118            Put ("< ");
119            for B in Buffer'First .. Buffer_Last loop
120               Put (Character'Val (Buffer (B)));
121            end loop;
122            New_Line;
123         end if;
124      end Update_Buffer;
125
126   begin
127      --  loop until there is something in the buffer.
128      --  This is a blocking procedure.
129
130      loop
131         begin
132            if From.Index > From.Buffer_Last then
133               Update_Buffer;
134            end if;
135
136            if From.Index <= From.Buffer_Last then
137               From.Es.Read (From.Buffer.all, From.Index, C);
138               C := From.Cs.To_Unicode (C);
139               return;
140            end if;
141
142         exception
143            when Incomplete_Encoding =>
144               --  Incomplete byte sequence at end of the buffer, is not an
145               --  error.
146               --  Loop until buffer is upated with enough data to find out
147               --  whether we have a fully invalid sequence or a complete one.
148               null;
149         end;
150      end loop;
151   end Next_Char;
152
153   ---------
154   -- Eof --
155   ---------
156
157   function Eof (From : Socket_Input) return Boolean is
158   begin
159      --  Even with no data in the buffer, the input must never be considered
160      --  end of file except when the socket was closed and there is no more
161      --  data to process.
162
163      return From.End_Of_File and then From.Index > From.Buffer_Last;
164   end Eof;
165
166end Input_Sources.Socket;
167