This file is indexed.

/usr/share/ada/adainclude/aws/aws-messages.adb is in libaws2.10.2-dev 2.10.2-4.

This file is owned by root:root, with mode 0o644.

The actual contents of the file can be viewed below.

  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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
------------------------------------------------------------------------------
--                              Ada Web Server                              --
--                                                                          --
--                     Copyright (C) 2000-2011, AdaCore                     --
--                                                                          --
--  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.          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Directories;
with Ada.Strings.Unbounded;

with AWS.Headers.Values;
with AWS.Utils;

package body AWS.Messages is

   use Ada.Strings.Unbounded;

   subtype Status_Code_Image is String (1 .. 3);

   S100_Message : aliased constant String := "Continue";
   S101_Message : aliased constant String := "Switching Protocols";

   S102_Message : aliased constant String := "Processing";
   --  Introduced in the WebDAV HTTP extension, refer to RFC2518

   S200_Message : aliased constant String := "OK";
   S201_Message : aliased constant String := "Created";
   S202_Message : aliased constant String := "Accepted";
   S203_Message : aliased constant String := "Non-Authoritative Information";
   S204_Message : aliased constant String := "No Content";
   S205_Message : aliased constant String := "Reset Content";
   S206_Message : aliased constant String := "Partial Content";

   S207_Message : aliased constant String := "Multi-Status";
   --  Introduced in the WebDAV HTTP extension, refer to RFC4918

   S300_Message : aliased constant String := "Multiple Choices";
   S301_Message : aliased constant String := "Moved Permanently";
   S302_Message : aliased constant String := "Found";
   S303_Message : aliased constant String := "See Other";
   S304_Message : aliased constant String := "Not Modified";
   S305_Message : aliased constant String := "Use Proxy";
   S307_Message : aliased constant String := "Temporary Redirect";

   S400_Message : aliased constant String := "Bad Request";
   S401_Message : aliased constant String := "Unauthorized";
   S402_Message : aliased constant String := "Payment Required";
   S403_Message : aliased constant String := "Forbidden";
   S404_Message : aliased constant String := "Not Found";
   S405_Message : aliased constant String := "Method Not Allowed";
   S406_Message : aliased constant String := "Not Acceptable";
   S407_Message : aliased constant String := "Proxy Authentication Required";
   S408_Message : aliased constant String := "Request Time-out";
   S409_Message : aliased constant String := "Conflict";
   S410_Message : aliased constant String := "Gone";
   S411_Message : aliased constant String := "Length Required";
   S412_Message : aliased constant String := "Precondition Failed";
   S413_Message : aliased constant String := "Request Entity Too Large";
   S414_Message : aliased constant String := "Request-URI Too Large";
   S415_Message : aliased constant String := "Unsupported Media Type";
   S416_Message : aliased constant String := "Requestd range not satisfiable";
   S417_Message : aliased constant String := "Expectation Failed";

   S422_Message : aliased constant String := "Unprocessable Entity";
   S423_Message : aliased constant String := "Locked";
   S424_Message : aliased constant String := "Failed Dependency";
   --  Introduced in the WebDAV HTTP extension, refer to RFC4918

   S500_Message : aliased constant String := "Internal Server Error";
   S501_Message : aliased constant String := "Not Implemented";
   S502_Message : aliased constant String := "Bad Gateway";
   S503_Message : aliased constant String := "Service Unavailable";
   S504_Message : aliased constant String := "Gateway Time-out";
   S505_Message : aliased constant String := "HTTP Version not supported";

   S507_Message : aliased constant String := "Insufficient Storage";
   --  Introduced in the WebDAV HTTP extension, refer to RFC4918

   type Status_Data is record
      Code          : Status_Code_Image;
      Reason_Phrase : access constant String;
   end record;

   Status_Messages : constant array (Status_Code) of Status_Data
     := (S100 => ("100", S100_Message'Access),
         S101 => ("101", S101_Message'Access),
         S102 => ("102", S102_Message'Access),
         S200 => ("200", S200_Message'Access),
         S201 => ("201", S201_Message'Access),
         S202 => ("202", S202_Message'Access),
         S203 => ("203", S203_Message'Access),
         S204 => ("204", S204_Message'Access),
         S205 => ("205", S205_Message'Access),
         S206 => ("206", S206_Message'Access),
         S207 => ("207", S207_Message'Access),
         S300 => ("300", S300_Message'Access),
         S301 => ("301", S301_Message'Access),
         S302 => ("302", S302_Message'Access),
         S303 => ("303", S303_Message'Access),
         S304 => ("304", S304_Message'Access),
         S305 => ("305", S305_Message'Access),
         S307 => ("307", S307_Message'Access),
         S400 => ("400", S400_Message'Access),
         S401 => ("401", S401_Message'Access),
         S402 => ("402", S402_Message'Access),
         S403 => ("403", S403_Message'Access),
         S404 => ("404", S404_Message'Access),
         S405 => ("405", S405_Message'Access),
         S406 => ("406", S406_Message'Access),
         S407 => ("407", S407_Message'Access),
         S408 => ("408", S408_Message'Access),
         S409 => ("409", S409_Message'Access),
         S410 => ("410", S410_Message'Access),
         S411 => ("411", S411_Message'Access),
         S412 => ("412", S412_Message'Access),
         S413 => ("413", S413_Message'Access),
         S414 => ("414", S414_Message'Access),
         S415 => ("415", S415_Message'Access),
         S416 => ("416", S416_Message'Access),
         S417 => ("417", S417_Message'Access),
         S422 => ("422", S422_Message'Access),
         S423 => ("422", S423_Message'Access),
         S424 => ("422", S424_Message'Access),
         S500 => ("500", S500_Message'Access),
         S501 => ("501", S501_Message'Access),
         S502 => ("502", S502_Message'Access),
         S503 => ("503", S503_Message'Access),
         S504 => ("504", S504_Message'Access),
         S505 => ("505", S505_Message'Access),
         S507 => ("507", S507_Message'Access));

   Month_Name : constant array (Calendar.Month_Number) of String (1 .. 3)
     := ("Jan", "Feb", "Mar", "Apr", "May", "Jun",
         "Jul", "Aug", "Sep", "Oct", "Nov", "Dec");

   HD : constant String := ": ";
   --  Header delimiter with space for well formatting

   ---------------------
   -- Accept_Encoding --
   ---------------------

   function Accept_Encoding (Encoding : String) return String is
   begin
      return Accept_Encoding_Token & HD & Encoding;
   end Accept_Encoding;

   ---------------------
   -- Accept_Language --
   ---------------------

   function Accept_Language (Mode : String) return String is
   begin
      return Accept_Language_Token & HD & Mode;
   end Accept_Language;

   -----------------
   -- Accept_Type --
   -----------------

   function Accept_Type (Mode : String) return String is
   begin
      return Accept_Token & HD & Mode;
   end Accept_Type;

   -------------------
   -- Authorization --
   -------------------

   function Authorization (Mode, Password : String) return String is
   begin
      return Authorization_Token & HD & Mode & ' ' & Password;
   end Authorization;

   -------------------
   -- Cache_Control --
   -------------------

   function Cache_Control (Option : Cache_Option) return String is
   begin
      return Cache_Control_Token & HD & String (Option);
   end Cache_Control;

   function Cache_Control (Data : Cache_Data) return String is
   begin
      return Cache_Control (To_Cache_Option (Data));
   end Cache_Control;

   ----------------
   -- Connection --
   ----------------

   function Connection (Mode : String) return String is
   begin
      return Connection_Token & HD & Mode;
   end Connection;

   -------------------------
   -- Content_Disposition --
   -------------------------

   function Content_Disposition
     (Format, Name, Filename : String) return String is
   begin
      if Filename = "" then
         return Content_Disposition_Token & HD & Format
           & "; name=""" & Name & '"';
      else
         return Content_Disposition_Token & HD & Format
           & "; name=""" & Name & """; filename="""
           & Directories.Simple_Name (Filename) & '"';
      end if;
   end Content_Disposition;

   --------------------
   -- Content_Length --
   --------------------

   function Content_Length (Size : Stream_Element_Offset) return String is
   begin
      return Content_Length_Token & ':' & Stream_Element_Offset'Image (Size);
   end Content_Length;

   ------------------
   -- Content_Type --
   ------------------

   function Content_Type
     (Format : String; Boundary : String := "") return String is
   begin
      if Boundary = "" then
         return Content_Type_Token & HD & Format;

      else
         return Content_Type_Token & HD & Format
           & "; boundary=""" & Boundary & '"';
      end if;
   end Content_Type;

   ------------
   -- Cookie --
   ------------

   function Cookie (Value : String) return String is
   begin
      return Cookie_Token & HD & Value;
   end Cookie;

   -----------------
   -- Create_ETag --
   -----------------

   function Create_ETag
     (Name : String; Weak : Boolean := False) return ETag_Value
   is
      ET : constant ETag_Value := '"' & ETag_Value (Name) & '"';
   begin
      if Weak then
         return "W/" & ET;
      else
         return ET;
      end if;
   end Create_ETag;

   ----------------
   -- Data_Range --
   ----------------

   function Data_Range (Value : String) return String is
   begin
      return Range_Token & HD & Value;
   end Data_Range;

   ----------
   -- ETag --
   ----------

   function ETag (Value : ETag_Value) return String is
   begin
      return ETag_Token & HD & String (Value);
   end ETag;

   -------------
   -- Expires --
   -------------

   function Expires (Date : Calendar.Time) return String is
   begin
      return Expires_Token & HD & To_HTTP_Date (Date);
   end Expires;

   ----------
   -- Host --
   ----------

   function Host (Name : String) return String is
   begin
      return Host_Token & HD & Name;
   end Host;

   -----------
   -- Image --
   -----------

   function Image (S : Status_Code) return String is
   begin
      return Status_Messages (S).Code;
   end Image;

   -------------------
   -- Last_Modified --
   -------------------

   function Last_Modified (Date : Calendar.Time) return String is
   begin
      return Last_Modified_Token & HD & To_HTTP_Date (Date);
   end Last_Modified;

   --------------
   -- Location --
   --------------

   function Location (URL : String) return String is
   begin
      return Location_Token & HD & URL;
   end Location;

   -------------------------
   -- Proxy_Authorization --
   -------------------------

   function Proxy_Authorization (Mode, Password : String) return String is
   begin
      return Proxy_Authorization_Token & HD & Mode & ' ' & Password;
   end Proxy_Authorization;

   ----------------------
   -- Proxy_Connection --
   ----------------------

   function Proxy_Connection (Mode : String) return String is
   begin
      return Proxy_Connection_Token & HD & Mode;
   end Proxy_Connection;

   -------------------
   -- Reason_Phrase --
   -------------------

   function Reason_Phrase (S : Status_Code) return String is
   begin
      return Status_Messages (S).Reason_Phrase.all;
   end Reason_Phrase;

   ----------------
   -- SOAPAction --
   ----------------

   function SOAPAction (URI : String) return String is
   begin
      return SOAPAction_Token & HD & '"' & URI & '"';
   end SOAPAction;

   -----------------
   -- Status_Line --
   -----------------

   function Status_Line (Code : Status_Code) return String is
   begin
      return HTTP_Version & ' '
        & Status_Messages (Code).Code & ' '
        & Status_Messages (Code).Reason_Phrase.all;
   end Status_Line;

   -------------------
   -- To_Cache_Data --
   -------------------

   function To_Cache_Data
     (Kind : Cache_Kind; Value : Cache_Option) return Cache_Data
   is
      use AWS.Headers;

      Result : Cache_Data (Kind);

      procedure Simple_Value (Item : String; Quit : in out Boolean);
      --  Receives un-named value

      procedure Named_Value (Name, Value : String; Quit : in out Boolean);
      --  Receives named value

      -----------------
      -- Named_Value --
      -----------------

      procedure Named_Value (Name, Value : String; Quit : in out Boolean) is
      begin
         Quit := False;

         if Utils.Is_Number (Value) then
            if Name = "max-stale" then
               Result.Max_Stale := Delta_Seconds'Value (Value);

            elsif Name = "min-fresh" then
               Result.Min_Fresh := Delta_Seconds'Value (Value);

            elsif Name = "max-age" then
               Result.Max_Age := Delta_Seconds'Value (Value);

            elsif Name = "s-maxage" then
               Result.S_Max_Age := Delta_Seconds'Value (Value);
            end if;

         else
            if Name = "private" then
               Result.Private_Field := To_Unbounded_String (Value);
            end if;
         end if;
      end Named_Value;

      -----------
      -- Value --
      -----------

      procedure Simple_Value (Item : String; Quit : in out Boolean) is
      begin
         Quit := False;

         if Item = "no-cache" then
            Result.No_Cache := True;

         elsif Item = "no-store" then
            Result.No_Store := True;

         elsif Item = "no-transform" then
            Result.No_Transform := True;

         elsif Item = "only-if-cached" then
            Result.Only_If_Cached := True;

         elsif Item = "public" then
            Result.Public := True;

         elsif Item = "private" then
            Result.Private_Field := All_Private;

         elsif Item = "must-revalidate" then
            Result.Must_Revalidate := True;

         elsif Item = "proxy-revalidate" then
            Result.Proxy_Revalidate := True;
         end if;
      end Simple_Value;

      procedure Parse is new Headers.Values.Parse (Simple_Value, Named_Value);

   begin
      Parse (String (Value));
      return Result;
   end To_Cache_Data;

   ---------------------
   -- To_Cache_Option --
   ---------------------

   function To_Cache_Option (Data : Cache_Data) return Cache_Option is
      Result : Unbounded_String;
   begin
      if Data.No_Cache then
         Utils.Append_With_Sep (Result, "no-cache");
      end if;

      if Data.No_Store then
         Utils.Append_With_Sep (Result, "no-store");
      end if;

      if Data.No_Transform then
         Utils.Append_With_Sep (Result, "no-transform");
      end if;

      if Data.Max_Age /= Unset then
         Utils.Append_With_Sep
           (Result, "max-age=" & Utils.Image (Integer (Data.Max_Age)));
      end if;

      case Data.CKind is
         when Request =>
            if Data.Max_Stale /= Unset then
               if Data.Max_Stale = Any_Max_Stale then
                  Utils.Append_With_Sep (Result, "max-stale");
               else
                  Utils.Append_With_Sep
                    (Result, "max-stale="
                     & Utils.Image (Integer (Data.Max_Stale)));
               end if;
            end if;

            if Data.Min_Fresh /= Unset then
               Utils.Append_With_Sep
                 (Result, "min-fresh="
                  & Utils.Image (Integer (Data.Min_Fresh)));
            end if;

            if Data.Only_If_Cached then
               Utils.Append_With_Sep (Result, "only-if-cached");
            end if;

         when Response =>
            if Data.S_Max_Age /= Unset then
               Utils.Append_With_Sep
                 (Result, "s-maxage="
                  & Utils.Image (Integer (Data.S_Max_Age)));
            end if;

            if Data.Public then
               Utils.Append_With_Sep (Result, "public");
            end if;

            if Data.Private_Field /= Private_Unset then
               if Data.Private_Field = All_Private then
                  Utils.Append_With_Sep (Result, "private");
               else
                  Utils.Append_With_Sep
                    (Result, "private=" & To_String (Data.Private_Field));
               end if;
            end if;

            if Data.Must_Revalidate then
               Utils.Append_With_Sep (Result, "must-revalidate");
            end if;

            if Data.Proxy_Revalidate then
               Utils.Append_With_Sep (Result, "proxy-revalidate");
            end if;
      end case;

      return Cache_Option (To_String (Result));
   end To_Cache_Option;

   ------------------
   -- To_HTTP_Date --
   ------------------

   function To_HTTP_Date (Time : Calendar.Time) return String is

      function Truncation (S : Calendar.Day_Duration) return Natural;
      --  returns the integral value of S

      function Image (V : Natural) return String;
      --  returns V image without the leading space and with leading zero if
      --  only one digit

      function Weekday (Date : Calendar.Time) return String;
      --  returns the weekday as a 3 letters string for the Date

      -----------
      -- Image --
      -----------

      function Image (V : Natural) return String is
         V_Image : constant String := Natural'Image (V);
      begin
         if V_Image'Length = 2 then
            --  only one digit add a leading zero
            return '0' & V_Image (2 .. V_Image'Last);
         else
            return V_Image (2 .. V_Image'Last);
         end if;
      end Image;

      ----------------
      -- Truncation --
      ----------------

      function Truncation (S : Calendar.Day_Duration) return Natural is
      begin
         if S = 0.0 then
            return 0;
         else
            return Natural (S - 0.5);
         end if;
      end Truncation;

      -------------
      -- Weekday --
      -------------

      function Weekday (Date : Calendar.Time) return String is

         Day_Names : constant array (Integer range 0 .. 6) of String (1 .. 3)
           := ("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat");

         C         : Integer;
         Y         : Integer := Calendar.Year (Date);
         M         : Integer := Calendar.Month (Date);
         D         : constant Integer := Calendar.Day (Date);

      begin
         --  Calculate day of week by using Zeller's congruence
         if M < 3 then
            Y := Y - 1;
            M := M + 10;
         else
            M := M - 2;
         end if;

         C := Y / 100;     --  first two digits of Year
         Y := Y mod 100;   --  last two digits of Year

         return Day_Names (((26 * M - 2) / 10
                            + D
                            + Y
                            + Y / 4
                            + C / 4
                            - 2 * C) mod 7);
      end Weekday;

      Day  : constant String  := Image (Calendar.Day (Time));
      Mon  : constant String  := Month_Name (Calendar.Month (Time));
      Year : constant String  := Image (Calendar.Year (Time));

      Secs : constant Natural := Truncation (Calendar.Seconds (Time));

      Tmp  : constant Natural := Secs mod 3600;

      H    : constant String  := Image (Secs / 3600);
      M    : constant String  := Image (Tmp / 60);
      S    : constant String  := Image (Tmp mod 60);
   begin
      return Weekday (Time) & ", " & Day & ' ' & Mon & ' ' & Year & ' '
        & H & ':' & M & ':' & S & " GMT";
   end To_HTTP_Date;

   -------------
   -- To_Time --
   -------------

   function To_Time (HTTP_Date : String) return Calendar.Time is

      function Month_Number
        (Month_Name : String) return Calendar.Month_Number;
      --  returns the month number given a 3 letter month name

      F : constant Positive := HTTP_Date'First;

      ------------------
      -- Month_Number --
      ------------------

      function Month_Number
        (Month_Name : String) return Calendar.Month_Number is
      begin
         for I in Calendar.Month_Number loop
            if Month_Name = Messages.Month_Name (I) then
               return I;
            end if;
         end loop;

         raise Constraint_Error
           with "Month_Number: Wrong Month name (" & Month_Name & ')';
      end Month_Number;

   begin
      return Calendar.Time_Of
        (Year    => Calendar.Year_Number'Value (HTTP_Date (F + 12 .. F + 15)),
         Month   => Month_Number (HTTP_Date (F + 8 .. F + 10)),
         Day     => Calendar.Day_Number'Value (HTTP_Date (F + 5 .. F + 6)),
         Seconds => Calendar.Day_Duration
         (Natural'Value (HTTP_Date (F + 17 .. F + 18)) * 3600
          + Natural'Value (HTTP_Date (F + 20 .. F + 21)) * 60
          + Natural'Value (HTTP_Date (F + 23 .. F + 24))));
   end To_Time;

   -----------------------
   -- Transfer_Encoding --
   -----------------------

   function Transfer_Encoding (Encoding : String) return String is
   begin
      return Transfer_Encoding_Token & HD & Encoding;
   end Transfer_Encoding;

   ----------------
   -- User_Agent --
   ----------------

   function User_Agent (Name : String) return String is
   begin
      return User_Agent_Token & HD & Name;
   end User_Agent;

   ----------------------
   -- Www_Authenticate --
   ----------------------

   function WWW_Authenticate (Realm : String) return String is
   begin
      return WWW_Authenticate_Token & HD & "Basic realm=""" & Realm & """";
   end WWW_Authenticate;

   function WWW_Authenticate
     (Realm, Nonce : String; Stale : Boolean) return String is
   begin
      return WWW_Authenticate_Token & HD
        & "Digest qop=""auth"", realm=""" & Realm
        & """, stale=""" & Boolean'Image (Stale)
        & """, nonce=""" & Nonce & """";
   end WWW_Authenticate;

end AWS.Messages;