1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--                               Web Framework                              --
6--                                                                          --
7--                        Runtime Library Component                         --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2012-2015, Vadim Godunko <vgodunko@gmail.com>                --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 5108 $ $Date: 2015-01-12 19:14:16 +0300 (Mon, 12 Jan 2015) $
43------------------------------------------------------------------------------
44with League.Base_Codecs;
45with Web_Services.SOAP.Security.Constants;
46
47package body Web_Services.SOAP.Security.Headers.Decoders is
48
49   use Web_Services.SOAP.Security.Constants;
50   use type League.Strings.Universal_String;
51
52   ----------------
53   -- Characters --
54   ----------------
55
56   overriding procedure Characters
57    (Self    : in out Security_Header_Decoder;
58     Text    : League.Strings.Universal_String;
59     Success : in out Boolean)
60   is
61      pragma Unreferenced (Success);
62
63   begin
64      if Self.Collect then
65         Self.Text.Append (Text);
66      end if;
67   end Characters;
68
69   ------------
70   -- Create --
71   ------------
72
73   overriding function Create
74    (URI : not null access League.Strings.Universal_String)
75       return Security_Header_Decoder
76   is
77      pragma Unreferenced (URI);
78
79   begin
80      return Self : Security_Header_Decoder do
81         Self.Token := new Username_Token_Header;
82      end return;
83   end Create;
84
85   -----------------
86   -- End_Element --
87   -----------------
88
89   overriding procedure End_Element
90    (Self           : in out Security_Header_Decoder;
91     Namespace_URI  : League.Strings.Universal_String;
92     Local_Name     : League.Strings.Universal_String;
93     Success        : in out Boolean) is
94   begin
95      if Namespace_URI = WSSE_Namespace_URI then
96         if Local_Name = Username_Element then
97            Self.Token.Username := Self.Text;
98            Self.Text.Clear;
99            Self.Collect := False;
100
101         elsif Local_Name = Password_Element then
102            case Self.Token.Mode is
103               when Text =>
104                  Self.Token.Password := Self.Text;
105
106               when Digest =>
107                  begin
108                     Self.Token.Digest :=
109                       League.Base_Codecs.From_Base_64 (Self.Text);
110
111                  exception
112                     when Constraint_Error =>
113                        --  Constraint_Error can be raised by From_Base_64
114                        --  function when source data is mailformed.
115
116                        Success := False;
117                  end;
118            end case;
119
120            Self.Text.Clear;
121            Self.Collect := False;
122
123         elsif Local_Name = Nonce_Element then
124            begin
125               Self.Token.Nonce := League.Base_Codecs.From_Base_64 (Self.Text);
126               Self.Text.Clear;
127               Self.Collect := False;
128
129            exception
130               when Constraint_Error =>
131                  --  Constraint_Error can be raised by From_Base_64 function
132                  --  when source data is mailformed.
133
134                  Success := False;
135            end;
136         end if;
137
138      elsif Namespace_URI = WSU_Namespace_URI then
139         if Local_Name = Created_Element then
140            Self.Token.Created := Self.Text;
141            Self.Text.Clear;
142            Self.Collect := False;
143         end if;
144      end if;
145   end End_Element;
146
147   ------------
148   -- Header --
149   ------------
150
151   overriding function Header
152    (Self : Security_Header_Decoder)
153       return not null Web_Services.SOAP.Headers.SOAP_Header_Access is
154   begin
155      return Web_Services.SOAP.Headers.SOAP_Header_Access (Self.Token);
156   end Header;
157
158   -------------------
159   -- Start_Element --
160   -------------------
161
162   overriding procedure Start_Element
163    (Self           : in out Security_Header_Decoder;
164     Namespace_URI  : League.Strings.Universal_String;
165     Local_Name     : League.Strings.Universal_String;
166     Attributes     : XML.SAX.Attributes.SAX_Attributes;
167     Success        : in out Boolean)
168   is
169      Value : League.Strings.Universal_String;
170
171   begin
172      if Namespace_URI = WSSE_Namespace_URI then
173         if Local_Name = Security_Element then
174            null;
175
176         elsif Local_Name = Username_Token_Element then
177            null;
178
179         elsif Local_Name = Username_Element then
180            Self.Collect := True;
181            Self.Text.Clear;
182
183         elsif Local_Name = Password_Element then
184            Value := Attributes.Value (Type_Attribute);
185
186            if Value = Password_Text_URI then
187               Self.Token.Mode := Text;
188               Self.Collect := True;
189               Self.Text.Clear;
190
191            elsif Value = Password_Digest_URI then
192               Self.Token.Mode := Digest;
193               Self.Collect := True;
194               Self.Text.Clear;
195
196            else
197               --  Type of wsse:Password is not known, stop processing and
198               --  report error.
199
200               Success := False;
201            end if;
202
203         elsif Local_Name = Nonce_Element then
204            Self.Collect := True;
205            Self.Text.Clear;
206
207         else
208            Success := False;
209         end if;
210
211      elsif Namespace_URI = WSU_Namespace_URI then
212         if Local_Name = Created_Element then
213            Self.Collect := True;
214            Self.Text.Clear;
215
216         else
217            Success := False;
218         end if;
219
220      else
221         Success := False;
222      end if;
223   end Start_Element;
224
225end Web_Services.SOAP.Security.Headers.Decoders;
226