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