- 796122DCF307899111D2909509460B1DE5215EF1DFADB88AF3F3B2654754AA225ACF79FF0B50BE884F184966920BCD30E236585FA46846DC36B8F58F67C726D1+ FD5121B49FCBCB70293B002298FC82272EF291E959FE63D17B5B22BA02B1ABB2B1D12A6D0D9541CAEBE43A300FE08CC329FBCACE81B8341A00296F66EB182A84smg_comms/src/messages.adb(4 . 6)(4 . 7)
47 with Interfaces; use Interfaces;
48 with Serpent;
49 with System; use System;
50 with Ada.Assertions; use Ada.Assertions;
51
52 package body Messages is
53
(55 . 6)(56 . 299)
55 end if;
56 end Read_KMgm_SMsg;
57
58 ------ File Transfer ------
59 procedure Write_File_Transfer( Chunk : in File_Chunk;
60 Msg : out Raw_Types.Serpent_Msg) is
61 Pos: Integer := Msg'First;
62 U16: Interfaces.Unsigned_16;
63 begin
64 -- write type ID
65 Msg(Pos) := File_Transfer_S_Type;
66 Pos := Pos + 1;
67
68 -- write filename as text field (size+2, text)
69 -- check against overflows
70 if Chunk.Name_Len > Text_Len'Last - 2 or
71 Pos + Integer(Chunk.Name_Len) + 2 > Msg'Last then
72 raise Invalid_Msg;
73 end if;
74
75 -- write total size: filename size + 2
76 U16 := Interfaces.Unsigned_16( Chunk.Name_Len + 2 );
77 Write_U16( Msg, Pos, U16 );
78
79 -- write filename
80 String_To_Octets( Chunk.Filename,
81 Msg(Pos..Pos+Integer(Chunk.Name_Len)-1) );
82 Pos := Pos + Integer(Chunk.Name_Len);
83
84 --write content
85 -- check against overflow, including the 2 octets for counter at the end
86 if Chunk.Len > Text_Len'Last - 2 or
87 Pos + Integer(Chunk.Len) + 4 > Msg'Last then
88 raise Invalid_Msg;
89 end if;
90
91 -- write total size for this text field
92 U16 := Interfaces.Unsigned_16( Chunk.Len + 2 );
93 Write_U16( Msg, Pos, U16 );
94
95 -- write actual content
96 Msg(Pos..Pos+Chunk.Content'Length-1) := Chunk.Content;
97 Pos := Pos + Chunk.Content'Length;
98
99 -- write counter
100 Write_U16( Msg, Pos, Chunk.Count );
101
102 -- write padding if needed
103 if Pos <= Msg'Last then
104 RNG.Get_Octets( Msg(Pos..Msg'Last) );
105 end if;
106
107 end Write_File_Transfer;
108
109 -- The opposite of Write_File_Transfer method above.
110 -- Counter will contain the message counter
111 -- Chunk will contain the chunk counter, filename and content
112 procedure Read_File_Transfer( Msg : in Raw_Types.Serpent_Msg;
113 Chunk : out File_Chunk) is
114 Pos: Integer := Msg'First;
115 U16: Interfaces.Unsigned_16;
116 S_Name, E_Name: Integer; --start/end for filename in Msg
117 S_Len: Text_Len; -- length of filename (needed as Text_Len anyway)
118 S_Content, E_Content: Integer; --start/end for content in Msg
119 Content_Len: text_Len; -- length of content (needed as Text_Len anyway)
120 begin
121 -- read and check type ID
122 if Msg(Pos) /= File_Transfer_S_Type then
123 raise Invalid_Msg;
124 end if;
125 Pos := Pos + 1;
126
127 -- read filename size
128 Read_U16( Msg, Pos, U16 );
129
130 -- check for overflow and underflow; filename size >= 1
131 if Pos + Integer(U16) - 2 > Msg'Last or
132 U16 < 3 then
133 raise Invalid_Msg;
134 end if;
135 U16 := U16 - 2;
136 S_Len := Text_Len(U16);
137
138 -- set start + end for reading filename later, when ready
139 S_Name := Pos;
140 E_Name := Pos + Integer(U16)-1;
141 Pos := Pos + S_Len;
142
143 -- read size of content
144 Read_U16( Msg, Pos, U16 );
145 -- check for overflow and underflow; content >=1; counter =2 octets
146 if Pos + Integer(U16) - 1 > Msg'Last or
147 U16 < 3 then
148 raise Invalid_msg;
149 end if;
150 U16 := U16 - 2;
151 Content_Len := Text_Len(U16);
152 -- set start and end for reading content later, when ready
153 S_Content := Pos;
154 E_Content := Pos + Integer(U16) - 1;
155 Pos := Pos + Content_Len;
156
157 -- read counter
158 Read_U16( Msg, Pos, U16 );
159 -- check chunking validity i.e. if counter>0 then no padding
160 if U16 /= 0 and Pos /= Msg'Last then
161 raise Invalid_Msg;
162 end if;
163
164 -- create File_Chunk structure and fill it with data from Msg
165 declare
166 FC : File_Chunk( Len => Content_Len,
167 Count => U16,
168 Name_Len => S_Len);
169 begin
170 -- read from Msg
171 FC.Content := Msg( S_Content..E_Content );
172 Octets_To_String( Msg( S_Name..E_Name ), FC.Filename);
173 -- copy to output var
174 Chunk := FC;
175 end;
176
177 end Read_File_Transfer;
178
179 ---- File Requests ----
180 procedure Write_File_Request( FR : in Filenames;
181 Counter : in Interfaces.Unsigned_16;
182 Msg : out Raw_Types.Serpent_Msg;
183 Written : out Natural) is
184 Pos : Integer := Msg'First;
185 Max_Pos: Integer := Msg'Last - 2; -- 2 octets at end for counter
186 Text_Sz: Integer;
187 Max_Sz : Integer;
188 begin
189 -- write ID for File Request type
190 Msg( Pos ) := File_Req_S_Type;
191 Pos := Pos + 1;
192
193 -- write Text size: filenames + separators
194 -- consider fewer filenames if they don't ALL fit
195 -- 2 octets are taken by size itself
196 Max_Sz := Max_Pos - Pos - 1;
197 Text_Sz := FR.Sz + FR.F_No - 1;
198 if Text_Sz > Max_Sz then
199 -- walk the array of filenames backwards and stop when they fit
200 Written := FR.F_No - 1;
201 -- calculate actual size written based on start of first discarded
202 -- filename and (Written -1) octets for needed separators
203 Text_Sz := Integer(FR.Starts(Written+1)) - FR.Starts'First +
204 (Written - 1);
205
206 -- loop until either fits or nothing left
207 while Written > 0 and Text_Sz > Max_Sz loop
208 Written := Written - 1;
209 Text_Sz := Integer(FR.Starts(Written+1))- FR.Starts'First +
210 (Written - 1);
211 end loop;
212 -- check that there is what to write, since nothing -> invalid message
213 if Written = 0 then
214 raise Invalid_Msg;
215 end if;
216
217 else --from if Text_Sz > Max_Sz
218 -- ALL are written
219 Written := FR.F_No;
220 end if;
221
222 -- write Text_Sz + 2 (i.e. TOTAL size)
223 if Text_Sz + 2 > Integer(Interfaces.Unsigned_16'Last) then
224 raise Invalid_Msg;
225 end if;
226
227 Write_U16( Msg, Pos, Interfaces.Unsigned_16(Text_Sz+2) );
228
229 -- write filenames separated by Sep
230 for I in 1..Written loop
231 declare
232 Start_Pos : Positive;
233 End_Pos : Positive;
234 Len : Positive;
235 begin
236 -- current start pos in FR.S
237 Start_Pos := Positive( FR.Starts( FR.Starts'First + I - 1));
238
239 -- calculate end based on start of next name or last
240 if I < FR.F_No then
241 End_Pos := Positive( FR.Starts( FR.Starts'First + I)) - 1;
242 else
243 End_Pos := FR.S'Last;
244 end if;
245
246 -- NB: this WILL fail if starting positions are not in order!
247 Len := End_Pos - Start_Pos + 1;
248 if Len <= 0 then
249 raise Invalid_Msg;
250 end if;
251
252 --write the actual filename
253 String_To_Octets( FR.S( Start_Pos..End_Pos ), Msg(Pos..Pos+Len-1) );
254 Pos := Pos + Len;
255
256 --if it's not the last one, write a separator
257 if I < Written then
258 Msg(Pos) := Sep;
259 Pos := Pos + 1;
260 end if;
261 end;
262 end loop;
263
264 -- write the message counter in little endian at all times
265 Write_U16( Msg, Pos, Counter );
266
267 -- write padding if needed
268 if Pos <= Msg'Last then
269 Rng.Get_Octets( Msg(Pos..Msg'Last) );
270 end if;
271 end Write_File_Request;
272
273 -- Reads a request for files; the opposite of Write_File_Request above
274 procedure Read_File_Request( Msg : in Raw_Types.Serpent_Msg;
275 Counter : out Interfaces.Unsigned_16;
276 FR : out Filenames) is
277 Pos : Integer := Msg'First;
278 Max_Pos : Integer := Msg'Last - 2; --at least 2 reserved for counter
279 Text_Sz : Integer;
280 Max_Sz : Integer := Max_Pos - Pos - 1; --text only i.e. w.o. size itself
281 F_No : Integer;
282 U16 : Interfaces.Unsigned_16;
283 begin
284 -- read type ID and check
285 if Msg(Pos) /= File_Req_S_Type then
286 raise Invalid_Msg;
287 end if;
288 Pos := Pos + 1;
289
290 -- read total size of filenames+separators
291 Read_U16( Msg, Pos, U16 );
292 Text_Sz := Integer(U16);
293 -- take away the 2 octets for size itself
294 Text_Sz := Text_Sz - 2;
295
296 -- check that Text_Sz is not overflowing/underflowing
297 if Text_Sz < 1 or Text_Sz > Max_Sz then
298 raise Invalid_Msg;
299 end if;
300
301 -- count first the separators to know how many filenames
302 -- NB: there is always at least 1 filename as Text_Sz > 0
303 F_No := 1;
304 for I in Pos .. Pos + Text_Sz - 1 loop
305 if Msg(I) = Sep then
306 F_No := F_No + 1;
307 end if;
308 end loop;
309
310 -- create the output structure and discard separators
311 -- text without separators should be Text_Sz - F_No + 1
312 -- (because ONLY one separator between 2 filenames allowed)
313 -- if it's not that => Invalid_Msg
314 -- F_No and Text_Sz are not overflow (earlier check + calc)
315 declare
316 F : Filenames(Text_Len(F_No), Text_Len(Text_Sz-F_No+1));
317 S_Pos : Positive;
318 Index : Positive;
319 begin
320 S_Pos := F.S'First;
321 Index := F.Starts'First;
322 F.Starts(Index) := Interfaces.Unsigned_16(S_Pos);
323
324 for I in Pos .. Pos + Text_Sz - 1 loop
325 -- copy over to F.S anything that is not separator
326 if Msg(I) /= Sep then
327 F.S( S_Pos ) := Character'Val(Msg(I));
328 S_Pos := S_Pos + 1;
329 else
330 -- if it's separator, check and if ok, add next as start
331 if I = Pos + Text_Sz or -- separator as last character is error
332 Msg(I+1) = Sep or -- 2 consecutive separators is error
333 Index >= F.Starts'Last then -- too many separators is error
334 raise Invalid_Msg;
335 else
336 Index := Index + 1;
337 F.Starts( Index ) := Interfaces.Unsigned_16(S_Pos);
338 end if;
339 end if;
340 end loop;
341
342 -- copy the whole structure to output variable
343 FR := F;
344 end;
345
346 -- read message counter now
347 Pos := Pos + Text_Sz;
348 Read_U16( Msg, Pos, Counter );
349
350 end Read_File_Request;
351
352 ------------------
353 -- RSA Messages --
(100 . 6)(394 . 27)
355 end if;
356 end Read_KMgm_RMsg;
357
358
359 ----------Utilities ----------
360 -- String to Octets conversion
361 procedure String_To_Octets(Str: in String; O: out Raw_Types.Octets) is
362 begin
363 Assert( Str'Length = O'Length );
364 for I in 1..Str'Length loop
365 O( O'First+I-1 ) := Character'Pos(Str(Str'First + I - 1 ));
366 end loop;
367 end String_To_Octets;
368
369 -- Octets to string conversion
370 -- NB: Str'Length has to be EQUAL to Octets'Length!
371 procedure Octets_To_String(O: in Raw_Types.Octets; Str: out String) is
372 begin
373 Assert( O'Length = Str'Length );
374 for I in 1..O'Length loop
375 Str( Str'First+I-1 ) := Character'Val(O(O'First + I - 1 ));
376 end loop;
377 end Octets_To_String;
378
379 ------------------
380 -- private part --
381 ------------------
(124 . 7)(439 . 6)
383 Msg : out Raw_Types.Octets) is
384 Pos : Integer := Msg'First;
385 Check : CRC32.CRC32;
386 PadLen: Integer;
387 K : Serpent.Key;
388 begin
389 -- write Type ID
(158 . 19)(472 . 11)
391 Pos := Pos + 1;
392
393 -- write message counter
394 Msg(Pos..Pos+1) := Raw_Types.Cast(Counter);
395 Cast_LE(Msg(Pos..Pos+1));
396 Pos := Pos + 2;
397 Write_U16( Msg, Pos, Counter );
398
399 -- write padding as needed; endianness is irrelevant here
400 PadLen := Msg'Last - Pos + 1;
401 if PadLen > 0 then
402 declare
403 Pad : Raw_Types.Octets(1..PadLen);
404 begin
405 RNG.Get_Octets( Pad );
406 Msg(Pos..Pos+PadLen-1) := Pad;
407 end;
408 if Pos <= Msg'Last then
409 RNG.Get_Octets( Msg(Pos..Msg'Last) );
410 end if;
411
412 end Write_SKeys;
(196 . 7)(502 . 6)
414 K : Serpent.Key;
415 Check : CRC32.CRC32;
416 O4 : Raw_Types.Octets_4;
417 O2 : Raw_Types.Octets_2;
418 begin
419 Pos := Pos + 1;
420 --read keys and check crc for each
(220 . 9)(525 . 7)
422 KS.Flag := Msg(Pos);
423 Pos := Pos + 1;
424 -- read and set message counter
425 O2 := Msg(Pos..Pos+1);
426 Cast_LE(O2);
427 Counter := Raw_Types.Cast(O2);
428 Read_U16( Msg, Pos, Counter );
429 -- rest of message is padding so it's ignored
430 -- copy keyset to output variable
431 Keyset := KS;
(266 . 12)(569 . 12)
433 end if;
434
435 -- write the message count
436 Msg(Pos..Pos+1) := Raw_Types.Cast( Counter );
437 Cast_LE( Msg(Pos..Pos+1) );
438 Pos := Pos + 2;
439 Write_U16( Msg, Pos, Counter );
440
441 -- pad with random octets until the end of Msg
442 RNG.Get_Octets( Msg(Pos..Msg'Last) );
443 if Pos <= Msg'Last then
444 RNG.Get_Octets( Msg(Pos..Msg'Last) );
445 end if;
446
447 end Write_KMgm;
448
(295 . 7)(598 . 6)
450 declare
451 N_Burnt : Counter_8bits := Counter_8bits(Msg(Burnt_Pos));
452 Mgm : Keys_Mgm(N_Burnt);
453 O2 : Raw_Types.Octets_2;
454 begin
455 -- read count of server keys requested
456 Mgm.N_Server := Msg(Pos);
(316 . 14)(618 . 33)
458 end if;
459
460 -- read and set message counter
461 O2 := Msg(Pos..Pos+1);
462 Cast_LE(O2);
463 Counter := Raw_Types.Cast(O2);
464 Read_U16( Msg, Pos, Counter );
465 -- rest of message is padding so it's ignored
466 -- copy the keys mgm structure to output param
467 KMgm := Mgm;
468 end;
469 end Read_KMgm;
470
471 -- Write a 16 bits value to Octets at Pos; Pos increases by 2.
472 procedure Write_U16( Msg: in out Raw_Types.Octets;
473 Pos: in out Natural;
474 U16: in Interfaces.Unsigned_16) is
475 begin
476 Msg(Pos..Pos+1) := Raw_Types.Cast(U16);
477 Cast_LE(Msg(Pos..Pos+1));
478 Pos := Pos + 2;
479 end Write_U16;
480
481 -- Read a 16-bits values from Octets from Pos; Pos increases by 2.
482 procedure Read_U16( Msg: in Raw_Types.Octets;
483 Pos: in out Natural;
484 U16: out Interfaces.Unsigned_16) is
485 O2 : Raw_Types.Octets_2;
486 begin
487 O2 := Msg(Pos..Pos+1);
488 Cast_LE(O2);
489 U16 := Raw_Types.Cast(O2);
490 Pos := Pos + 2;
491 end Read_U16;
492
493 end Messages;