1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187 | -- --
-- package Copyright (c) Dmitry A. Kazakov --
-- GNAT.Sockets.Server.Secure Luebeck --
-- Interface Winter, 2015 --
-- --
-- Last revision : 10:32 11 May 2019 --
-- --
-- This library 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 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. 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. --
-- --
-- As a special exception, if other files instantiate generics from --
-- this unit, or you link this unit with other files to produce an --
-- executable, this unit does not by itself cause the resulting --
-- executable to be covered by the GNU General Public License. This --
-- exception does not however invalidate any other reasons why the --
-- executable file might be covered by the GNU Public License. --
--____________________________________________________________________--
with GNUTLS; use GNUTLS;
with Interfaces.C; use Interfaces.C;
package GNAT.Sockets.Server.Secure is
--
-- Abstract_GNUTLS_Factory -- Abstract factory for TLS connections
--
-- Decoded_Size - Of the buffer containing decoded input
--
-- The factories creating servers accepting TLS connections must be
-- derived from this type. The implementation uses GNUTLS for hand-
-- shaking and encoding data. The authentification is handled from the
-- Prepare operation, which is called when a connection is established
-- and a TLSsession is created. Typically it would set some certificates
-- into the session.
--
type Abstract_GNUTLS_Factory
( Decoded_Size : Buffer_Length
) is abstract new Connections_Factory with private;
--
-- Create_Transport -- Overriding GNAT.Sockets.Server...
--
function Create_Transport
( Factory : access Abstract_GNUTLS_Factory;
Listener : access Connections_Server'Class;
Client : access Connection'Class
) return Encoder_Ptr;
--
-- Handshake_Completed -- Handshake completion call back
--
-- Factory - The TLS connection factory
-- Client - The client
-- Session - The TLS session
--
-- This procedure is called upon TLS handshake completion. The
-- implementation may use it in order to check the session, e.g.
-- verifying client's certificates. The default implementation does
-- nothing.
--
-- Exceptions :
--
-- Connection_Error - Silently drop connection
-- others - Drops connection
--
procedure Handshake_Completed
( Factory : in out Abstract_GNUTLS_Factory;
Client : in out Connection'Class;
Session : in out Session_Type
);
--
-- Overriding GNAT.Sockets.Server...
--
function Is_TLS_Capable
( Factory : Abstract_GNUTLS_Factory
) return Boolean;
--
-- Is_Trace_Decoded -- Check tracing
--
-- Factory - The TLS connection factory
--
-- Returns :
--
-- True if tracing decoded content is enabled
--
function Is_Trace_Decoded
( Factory : Abstract_GNUTLS_Factory
) return Boolean;
--
-- Is_Trace_Session -- Check tracing
--
-- Factory - The TLS connection factory
--
-- Returns :
--
-- True if session state tracing is enabled
--
function Is_Trace_Session
( Factory : Abstract_GNUTLS_Factory
) return Boolean;
--
-- Prepare -- TLS session
--
-- Factory - The TLS connection factory
-- Client - The client
-- Session - The TLS session to add certificates to
--
-- This procedure is called in order to add server certificates to the
-- specified session. This happens when a connection to client is
-- established. It can be more than one certificate.
--
procedure Prepare
( Factory : in out Abstract_GNUTLS_Factory;
Client : in out Connection'Class;
Session : in out Session_Type
) is abstract;
--
-- Set_TLS_Tracing -- Enable or disable TLS tracing
--
-- Factory - The TLS connection factory
-- Session - True if tracing of session state
-- Decoded - True if tracing decoded content must be enabled
--
-- This procedure is used to enable or disable tracing of security
-- actions.
--
procedure Set_TLS_Tracing
( Factory : in out Abstract_GNUTLS_Factory;
Session : Boolean;
Decoded : Boolean
);
private
type Abstract_GNUTLS_Factory
( Decoded_Size : Buffer_Length
) is abstract new Connections_Factory with
record
Trace_Session : Boolean := False;
Trace_Decoded : Boolean := False;
end record;
type TLS_Session_State is (TLS_Handshake, TLS_Exchange);
type TLS_Session
( Client : access Connection'Class;
Size : Buffer_Length;
Flags : Init_Flags
) is new Encoder (Size) with
record
Session : aliased Session_Type (Flags);
State : TLS_Session_State := TLS_Handshake;
end record;
--
-- Encode -- Overriding GNAT.Sockets.Server...
--
procedure Encode
( Transport : in out TLS_Session;
Client : in out Connection'Class;
Data : Stream_Element_Array;
Last : out Stream_Element_Offset
);
function Get_Session
( Client : Connection'Class
) return Session_Type_Ptr;
procedure Process
( Transport : in out TLS_Session;
Listener : in out Connections_Server'Class;
Client : in out Connection'Class;
Data_Left : out Boolean
);
procedure Read
( Client : in out Connection'Class;
Data : in out Stream_Element_Array;
Pointer : in out Stream_Element_Offset
);
procedure Write
( Client : in out Connection'Class;
Data : Stream_Element_Array;
Pointer : in out Stream_Element_Offset
);
end GNAT.Sockets.Server.Secure;
|