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