------------------------------------------------------------------------------ -- Ada Web Server -- -- -- -- Copyright (C) 2003-2022, AdaCore -- -- -- -- This library is free software; you can redistribute it and/or modify -- -- it under terms of the GNU General Public License as published by the -- -- Free Software Foundation; either version 3, 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. -- -- -- -- As a special exception under Section 7 of GPL version 3, you are -- -- granted additional permissions described in the GCC Runtime Library -- -- Exception, version 3.1, as published by the Free Software Foundation. -- -- -- -- You should have received a copy of the GNU General Public License and -- -- a copy of the GCC Runtime Library Exception along with this program; -- -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- -- . -- -- -- -- 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. -- ------------------------------------------------------------------------------ pragma Ada_2012; with Ada.Characters.Handling; with Ada.Containers.Indefinite_Vectors; with Ada.Directories; with Ada.Exceptions; with Ada.Strings.Fixed; with Ada.Strings.Maps; with Ada.Text_IO; with GNAT.OS_Lib; with DOM.Core.Nodes; with AWS.Utils; with SOAP.Utils; with SOAP.WSDL.Name_Spaces; with SOAP.XML; package body WSDL2AWS.WSDL.Parser is use type DOM.Core.Node; Verbose_Mode : Verbose_Level := 0; Skip_Error : Boolean := False; NS_SOAP : Unbounded_String; NS_Num : Natural := 0; type Look_Kind is (Complex_Type, Simple_Type, Element); type Look_Context is array (Look_Kind) of Boolean; Look_All : constant Look_Context := (others => True); package String_List is new Containers.Indefinite_Vectors (Positive, String); function Get_Node (Parent : DOM.Core.Node; Element : String; Name : String := ""; Target_Namespace : String := ""; NS : Boolean := False) return DOM.Core.Node; -- Returns child node named Element having the value Name for attribute -- "name" and Target_Namespace for attribute "targetNamespace" if -- specified. Note that Element can specified a hierarchy of names -- separated with dots (e.g. Elem1.Elem2.Elem3) as an XML path. function "+" (Str : String) return Unbounded_String renames To_Unbounded_String; function "-" (Str : Unbounded_String) return String renames To_String; procedure Parse_Service (O : in out Object'Class; Service : DOM.Core.Node; Document : SOAP.WSDL.Object); -- Parse WSDL service nodes procedure Parse_Binding (O : in out Object'Class; Binding : DOM.Core.Node; Document : SOAP.WSDL.Object); -- Parse WSDL binding nodes procedure Parse_Definitions (O : in out Object'Class; Definitions : DOM.Core.Node; Document : SOAP.WSDL.Object); -- Parse WSDL definition node procedure Parse_Operation (O : in out Object'Class; Operation : DOM.Core.Node; Document : SOAP.WSDL.Object); -- Parse WSDL operation nodes procedure Parse_PortType (O : in out Object'Class; Operation : DOM.Core.Node; Document : SOAP.WSDL.Object); -- Parse WSDL PortType nodes procedure Parse_Part (O : in out Object'Class; Part : DOM.Core.Node; Document : SOAP.WSDL.Object); -- Parse WSDL part nodes procedure Parse_Message (O : in out Object'Class; Message : DOM.Core.Node; Document : SOAP.WSDL.Object); -- Parse WSDL message nodes procedure Parse_Element (O : in out Object'Class; Element : DOM.Core.Node; Document : SOAP.WSDL.Object); -- Parse WSDL element nodes procedure Add_Parameter (O : in out Object'Class; Name : String; Type_Name : String) with Inline; -- Add parameter Name / P_Type into O using current mode (O.Mode) procedure Add_Parameter (O : in out Object'Class; Param : Parameters.Parameter) with Inline; -- Add parameter into O using current mode (O.Mode) function Parse_Parameter (O : in out Object'Class; N : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter; -- Returns parameter in node P function Parse_Record (O : in out Object'Class; R : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter; -- Returns record in node R function Parse_Array (O : in out Object'Class; R : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter; -- Returns array in node R function Parse_Set (O : in out Object'Class; S : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter; -- Returns array in node S. A set if used to handle parameters with a -- minOccurs or maxOccurs different to 1. function Parse_Simple (O : in out Object'Class; R : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter; -- Returns the derived or enumeration type in node N (N must be a -- simpleType schema node). procedure Parse_Schema (O : in out Object'Class; Root : DOM.Core.Node; XPath : String; Dir : String); -- Parse a schema node, relative schama path is interpreted as relative to -- Dir. function Is_Array (O : Object'Class; N : DOM.Core.Node) return Boolean; -- Returns True if N is an array description node. Set the array element -- name into the object. function Is_Record (O : Object'Class; N : DOM.Core.Node) return Boolean; -- Returns True if N is a struct description node function Get_Target_Name_Space (N : DOM.Core.Node) return SOAP.Name_Space.Object; -- Returns the targetNamespace procedure Register_Name_Spaces (N : DOM.Core.Node); -- Register namespace pointing at node N function Get_Namespaces_For (N : DOM.Core.Node) return String_List.Vector; -- Get all possible name spaces for the item at the given node. This is the -- target namespace and all imported namespace. function Look_For_Schema (N : DOM.Core.Node; Type_Name : String; Document : SOAP.WSDL.Object; Context : Look_Context := Look_All) return DOM.Core.Node; -- Look for schema starting at N function Is_Character (N : DOM.Core.Node; Type_Name : String; Document : SOAP.WSDL.Object) return Boolean; -- Returns True if Type_Name corresponds to a character type procedure Skip_Annotation (N : in out DOM.Core.Node); -- Skip annotation node function Get_Documentation (N : DOM.Core.Node) return String; -- Get text for the documentation node N procedure Get_Min_Max (S_Min, S_Max : String; Min, Max : out Natural); -- Returns the Min, Max values for the given string procedure Set_Binding_Style (O : in out Object'Class; N : DOM.Core.Node); -- Returns the binding style (value of attribute style) specified on the -- node N. Returns the empty string if not defined. ----------- -- Debug -- ----------- procedure Trace (Message : String; N : DOM.Core.Node); -- Display trace message and info about the node ---------------- -- Accept_RPC -- ---------------- procedure Accept_Document (O : in out Object'Class) is begin O.Accept_Document := True; end Accept_Document; ------------------- -- Add_Parameter -- ------------------- procedure Add_Parameter (O : in out Object'Class; Name : String; Type_Name : String) is NS : constant SOAP.Name_Space.Object := SOAP.WSDL.Name_Spaces.Get (SOAP.Utils.NS (Type_Name), SOAP.Name_Space.XSD); begin if not O.No_Param then Parameters.Append (O.Params (O.Mode), (WSDL.Types.K_Simple, +Name, O.Elmt_Name, Null_Unbounded_String, Typ => Types.Create (SOAP.Utils.No_NS (Type_Name), NS), Min => 1, Max => 1, Is_Set => False, Next => null)); end if; end Add_Parameter; procedure Add_Parameter (O : in out Object'Class; Param : Parameters.Parameter) is begin if not O.No_Param then Parameters.Append (O.Params (O.Mode), Param); end if; end Add_Parameter; ----------------------- -- Continue_On_Error -- ----------------------- procedure Continue_On_Error is begin Skip_Error := True; end Continue_On_Error; --------- -- enc -- --------- function enc (O : Object'Class) return SOAP.Name_Space.Object is begin return O.enc; end enc; -------------- -- Encoding -- -------------- function Encoding (O : Object'Class; Kind : Parameter_Mode) return SOAP.Types.Encoding_Style is begin case Kind is when Input => return O.I_Encoding; when Output | Fault => -- ??? fault taken as output return O.O_Encoding; end case; end Encoding; --------- -- env -- --------- function env (O : Object'Class) return SOAP.Name_Space.Object is begin return O.env; end env; ------------- -- Exclude -- ------------- procedure Exclude (O : in out Object; Operation : String) is Pos : Name_Set.Cursor; Success : Boolean; begin O.Exclude.Insert (Operation, Pos, Success); end Exclude; ----------------------- -- Get_Documentation -- ----------------------- function Get_Documentation (N : DOM.Core.Node) return String is Trim_Set : constant Strings.Maps.Character_Set := Strings.Maps.To_Set (ASCII.LF & ASCII.CR); D : DOM.Core.Node := DOM.Core.Nodes.First_Child (N); Doc : Unbounded_String; begin while D /= null loop if DOM.Core.Nodes.Node_Name (D) = "#text" then declare V : Unbounded_String := +DOM.Core.Nodes.Node_Value (D); P : Natural; E : Boolean := True; begin loop E := True; P := Index (V, " "); if P /= 0 then Strings.Unbounded.Delete (V, P, P); E := False; end if; P := Index (V, Trim_Set); if P /= 0 then Strings.Unbounded.Delete (V, P, P); E := False; end if; exit when E; end loop; if Doc /= Null_Unbounded_String then Append (Doc, " "); end if; -- Then finaly removes leading/trainling white spaces Append (Doc, Strings.Unbounded.Trim (V, Side => Strings.Both)); end; end if; D := DOM.Core.Nodes.Next_Sibling (D); end loop; return To_String (Doc); end Get_Documentation; ----------------- -- Get_Min_Max -- ----------------- procedure Get_Min_Max (S_Min, S_Max : String; Min, Max : out Natural) is begin if S_Min = "" then Min := 1; else Min := Natural'Value (S_Min); end if; if S_Max = "" then Max := 1; elsif Characters.Handling.To_Lower (S_Max) = "unbounded" then Max := Natural'Last; else Max := Positive'Value (S_Max); end if; end Get_Min_Max; ------------------------ -- Get_Namespaces_For -- ------------------------ function Get_Namespaces_For (N : DOM.Core.Node) return String_List.Vector is NS : constant SOAP.Name_Space.Object := Get_Target_Name_Space (N); R : DOM.Core.Node := N; V : String_List.Vector; begin Look_For_Import : loop if DOM.Core.Nodes.Local_Name (R) = "import" and then SOAP.XML.Get_Attr_Value (R, "namespace", True) /= "" then V.Append (SOAP.XML.Get_Attr_Value (R, "namespace", True)); end if; if DOM.Core.Nodes.Previous_Sibling (R) = null then R := DOM.Core.Nodes.Parent_Node (R); else R := DOM.Core.Nodes.Previous_Sibling (R); end if; exit Look_For_Import when R = null; end loop Look_For_Import; V.Append (SOAP.Name_Space.Value (NS)); return V; end Get_Namespaces_For; -------------- -- Get_Node -- -------------- function Get_Node (Parent : DOM.Core.Node; Element : String; Name : String := ""; Target_Namespace : String := ""; NS : Boolean := False) return DOM.Core.Node is function Get_Node_Int (Parent : DOM.Core.Node; Element : String; Name : String) return DOM.Core.Node; -- Recursive procedure that does the job ------------------ -- Get_Node_Int -- ------------------ function Get_Node_Int (Parent : DOM.Core.Node; Element : String; Name : String) return DOM.Core.Node is TNS : constant String := (if Target_Namespace = "" then "" else SOAP.Name_Space.Value (Get_Target_Name_Space (Parent))); N, R : DOM.Core.Node; E : Natural; begin if Element = "" then -- No more element to look for if Name in "" | SOAP.XML.Get_Attr_Value (Parent, "name") and then Target_Namespace = TNS then -- There is no attribute to look for or we are in the right -- node, return this node. return Parent; else -- No found otherwise return null; end if; end if; E := Strings.Fixed.Index (Element, "."); if E = 0 then -- No more separator, this is the last element E := Element'Last; else E := E - 1; end if; -- Iterate through childs, look for element N := SOAP.XML.First_Child (Parent); declare E_Name : constant String := Element (Element'First .. E); begin R := null; while N /= null loop if (not NS and then DOM.Core.Nodes.Local_Name (N) = E_Name) or else (NS and then DOM.Core.Nodes.Node_Name (N) = E_Name) then -- We found this element, check next one R := Get_Node_Int (N, Element (E + 2 .. Element'Last), Name); -- Exit now ff we have found the right node, otherwise let's -- try the next sibling. exit when R /= null; end if; N := SOAP.XML.Next_Sibling (N); end loop; end; return R; end Get_Node_Int; begin Trace ("(Get_Node) - " & Element & " -> " & Name, Parent); return Get_Node_Int (Parent, Element, Name); end Get_Node; --------------------------- -- Get_Target_Name_Space -- --------------------------- function Get_Target_Name_Space (N : DOM.Core.Node) return SOAP.Name_Space.Object is function Create (Value : String) return SOAP.Name_Space.Object; ------------ -- Create -- ------------ function Create (Value : String) return SOAP.Name_Space.Object is begin if SOAP.WSDL.Name_Spaces.Contains (Value) then return SOAP.Name_Space.Create (SOAP.WSDL.Name_Spaces.Get (Value), Value); else NS_Num := NS_Num + 1; declare Name : constant String := "n" & AWS.Utils.Image (NS_Num); begin SOAP.WSDL.Name_Spaces.Register (Value, Name); return SOAP.Name_Space.Create (Name, Value); end; end if; end Create; V : constant String := SOAP.XML.Get_Attr_Value (N, "targetNamespace", True); begin if V = "" then if DOM.Core.Nodes.Parent_Node (N) /= null then return Get_Target_Name_Space (DOM.Core.Nodes.Parent_Node (N)); else raise WSDL_Error with "cannot find name space"; end if; else return Create (V); end if; end Get_Target_Name_Space; -------------- -- Is_Array -- -------------- function Is_Array (O : Object'Class; N : DOM.Core.Node) return Boolean is function Array_Elements return Types.Object; -- Returns array's element type encoded in node L L : DOM.Core.Node := N; -------------------- -- Array_Elements -- -------------------- function Array_Elements return Types.Object is Attributes : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (L); begin -- Look for arrayType in Attributes list for K in 0 .. DOM.Core.Nodes.Length (Attributes) - 1 loop declare N : constant DOM.Core.Node := DOM.Core.Nodes.Item (Attributes, K); begin if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) = "arrayType" then -- Found get the value removing [] declare Value : constant String := DOM.Core.Nodes.Node_Value (N); First : Natural; Last : Natural; begin First := Strings.Fixed.Index (Value, "["); Last := Strings.Fixed.Index (Value, "]"); if First = 0 or else Last = 0 then raise WSDL_Error with "missing [] in arrayType value."; end if; if Last > First + 1 then O.Self.Array_Length := Natural'Value (Value (First + 1 .. Last - 1)); else O.Self.Array_Length := 0; end if; declare BNS : constant String := SOAP.Utils.NS (Value); begin if BNS = "" then return Types.Create (Value (Value'First .. First - 1), Get_Target_Name_Space (Is_Array.N)); else return Types.Create (Value (Value'First .. First - 1), SOAP.Name_Space.Create (BNS, SOAP.WSDL.Name_Spaces.Get (BNS))); end if; end; end; end if; end; end loop; raise WSDL_Error with "array element type not found."; end Array_Elements; begin if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "complexType" then L := SOAP.XML.First_Child (L); Skip_Annotation (L); if L /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "complexContent" then L := SOAP.XML.First_Child (L); if L /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "restriction" then L := SOAP.XML.First_Child (L); if L /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "attribute" then O.Self.Array_Elements := Array_Elements; return True; end if; end if; elsif L /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "sequence" then L := SOAP.XML.First_Child (L); if L /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "element" then -- Element must have minOccurs and maxOccurs attribute declare Min_Occurs : constant String := SOAP.XML.Get_Attr_Value (L, "minOccurs", False); Max_Occurs : constant String := SOAP.XML.Get_Attr_Value (L, "maxOccurs", False); E_Type : constant String := SOAP.XML.Get_Attr_Value (L, "type", True); E_NS : constant String := SOAP.Utils.NS (E_Type); begin if Min_Occurs /= "" and then Max_Occurs /= "" then if Max_Occurs = "unbounded" then O.Self.Array_Length := 0; else O.Self.Array_Length := Natural'Value (Max_Occurs); end if; -- And so the element type is on type attribute O.Self.Array_Elements := Types.Create (E_Type, (if E_NS = "" then Get_Target_Name_Space (L) else SOAP.Name_Space.Create (E_NS, SOAP.WSDL.Name_Spaces.Get (E_NS)))); return True; end if; end; end if; end if; end if; return False; end Is_Array; ------------------ -- Is_Character -- ------------------ function Is_Character (N : DOM.Core.Node; Type_Name : String; Document : SOAP.WSDL.Object) return Boolean is function Is_Character_Schema (R : DOM.Core.Node) return Boolean; ------------------------- -- Is_Character_Schema -- ------------------------- function Is_Character_Schema (R : DOM.Core.Node) return Boolean is function Character_Facet (Parent : DOM.Core.Node; Child : Boolean := False) return DOM.Core.Node; -- Returns the first node corresponding to a character type -- definition. It skips annotation tag for example. --------------------- -- Character_Facet -- --------------------- function Character_Facet (Parent : DOM.Core.Node; Child : Boolean := False) return DOM.Core.Node is N : DOM.Core.Node := Parent; begin if Child then N := SOAP.XML.First_Child (N); else N := SOAP.XML.Next_Sibling (N); end if; while N /= null and then DOM.Core.Nodes.Local_Name (N) /= "length" and then DOM.Core.Nodes.Local_Name (N) /= "minLength" and then DOM.Core.Nodes.Local_Name (N) /= "maxLength" loop N := SOAP.XML.Next_Sibling (N); end loop; return N; end Character_Facet; N : DOM.Core.Node := R; begin Trace ("(Is_Character_Schema)", R); if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) /= "simpleType" then return False; end if; -- Now check that if Name is Character and base is xsd:string -- that this is really an Ada Character type. For this the -- type must be constrained to a single character. -- -- Either we have the facet -- Or and -- Get restriction node N := SOAP.XML.First_Child (N); declare Base : constant String := SOAP.XML.Get_Attr_Value (N, "base", False); begin if Base /= "string" then -- The base type must be a string return False; end if; N := Character_Facet (N, Child => True); if N /= null and then DOM.Core.Nodes.Local_Name (N) = "length" then -- Check length if SOAP.XML.Get_Attr_Value (N, "value", False) /= "1" then -- Must be a single character return False; end if; elsif N /= null and then DOM.Core.Nodes.Local_Name (N) = "minLength" then if SOAP.XML.Get_Attr_Value (N, "value", False) /= "1" then -- Must be a single character return False; end if; N := Character_Facet (N); if N = null or else DOM.Core.Nodes.Local_Name (N) /= "maxLength" or else SOAP.XML.Get_Attr_Value (N, "value", False) /= "1" then -- Must be a single character return False; end if; elsif N /= null and then DOM.Core.Nodes.Local_Name (N) = "maxLength" then if SOAP.XML.Get_Attr_Value (N, "value", False) /= "1" then -- Must be a single character return False; end if; N := Character_Facet (N); if N = null or else DOM.Core.Nodes.Local_Name (N) /= "minLength" or else SOAP.XML.Get_Attr_Value (N, "value", False) /= "1" then -- Must be a single character return False; end if; else -- Must be a single character return False; end if; end; return True; end Is_Character_Schema; S : constant DOM.Core.Node := Look_For_Schema (N, Type_Name, Document); begin if S /= null and then Is_Character_Schema (S) then -- Generate the Character derived type reference declare Def : WSDL.Types.Definition (WSDL.Types.K_Derived); begin Def.Ref := WSDL.Types.Create (Type_Name, Get_Target_Name_Space (S)); Def.Parent := WSDL.Types.Create ("string", SOAP.Name_Space.Create ("xsd", SOAP.Name_Space.XSD_URL)); Def.Constraints.Length := 1; WSDL.Types.Register (Def); end; return True; else return False; end if; end Is_Character; --------------- -- Is_Record -- --------------- function Is_Record (O : Object'Class; N : DOM.Core.Node) return Boolean is pragma Unreferenced (O); L : DOM.Core.Node := N; Is_Extension : Boolean := False; begin if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "element" and then SOAP.XML.First_Child (L) /= null then -- Handle an element enclosing the complexType L := SOAP.XML.First_Child (L); end if; if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "complexType" then L := SOAP.XML.First_Child (L); Skip_Annotation (L); -- Empty complexType if L = null then return True; else if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "complexContent" then L := SOAP.XML.First_Child (L); end if; if L = null then raise WSDL_Error with "empty complexContent."; elsif SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "extension" then Is_Extension := True; L := SOAP.XML.First_Child (L); end if; end if; -- Empty extension if L = null then return True; end if; if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "all" or else SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "sequence" or else SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "choice" then L := SOAP.XML.First_Child (L); -- If we have a single element we must ensure that there is no -- minOccurs or maxOccurs defined otherwise this is an array. if L /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (L)) = "element" and then (SOAP.XML.Next_Sibling (L) /= null or else Is_Extension or else (SOAP.XML.Get_Attr_Value (L, "minOccurs") = "" and then SOAP.XML.Get_Attr_Value (L, "maxOccurs") = "")) then return True; end if; end if; end if; return False; end Is_Record; --------------------- -- Look_For_Schema -- --------------------- function Look_For_Schema (N : DOM.Core.Node; Type_Name : String; Document : SOAP.WSDL.Object; Context : Look_Context := Look_All) return DOM.Core.Node is pragma Unreferenced (Document); T_No_NS : constant String := SOAP.Utils.No_NS (Type_Name); T_NS : constant String := SOAP.Utils.NS (Type_Name); TNS : constant SOAP.Name_Space.Object := Get_Target_Name_Space (N); All_NS : constant String_List.Vector := Get_Namespaces_For (N); D : DOM.Core.Node; begin Trace ("(Look_For_Schema)", N); -- First look for imported schema declare Key : constant String := (if T_NS = "" then SOAP.WSDL.Name_Spaces.Get (SOAP.Name_Space.Value (TNS)) else T_NS); URL : constant String := (if SOAP.WSDL.Name_Spaces.Contains (Key) then SOAP.WSDL.Name_Spaces.Get (Key) else ""); procedure Look_Schema (S : DOM.Core.Node); -- Look for element/complexType/simpleType definition in schema ----------------- -- Look_Schema -- ----------------- procedure Look_Schema (S : DOM.Core.Node) is begin D := Get_Node (S, "element", T_No_NS, URL); if D = null and then Context (Complex_Type) then D := Get_Node (S, "complexType", T_No_NS, URL); end if; if D = null and then Context (Simple_Type) then D := Get_Node (S, "simpleType", T_No_NS, URL); end if; end Look_Schema; begin -- We have a name-space prefix, use it to find the corresponding -- schema definition. if URL /= "" then SOAP.WSDL.Schema.For_All (URL, Look_Schema'Access); end if; -- Check on the embedded schema if D = null then for U of All_NS loop SOAP.WSDL.Schema.For_All (U, Look_Schema'Access); exit when D /= null; end loop; end if; end; return D; end Look_For_Schema; ----------- -- Parse -- ----------- procedure Parse (O : in out Object'Class; Document : SOAP.WSDL.Object; Filename : String) is N : constant DOM.Core.Node := SOAP.XML.First_Child (DOM.Core.Node (Document)); NL : constant DOM.Core.Node_List := DOM.Core.Nodes.Child_Nodes (N); Found : Boolean := False; begin -- First set the directory containing the parsed WSDL, this is needed to -- be able to find imported xsd using relative paths. O.Dir := To_Unbounded_String (Directories.Containing_Directory (Filename)); -- First we want to parse the definitions node to get the namespaces Parse_Definitions (O, N, Document); -- Then we load all schemas Parse_Schema (O, DOM.Core.Node (Document), "definitions.types.schema", To_String (O.Dir)); -- Look for the service node for K in 0 .. DOM.Core.Nodes.Length (NL) - 1 loop declare S : constant DOM.Core.Node := DOM.Core.Nodes.Item (NL, K); begin if DOM.Core.Nodes.Local_Name (S) = "service" then Parse_Service (O, S, Document); Found := True; end if; end; end loop; if Verbose_Mode > 0 and then not Found then Text_IO.New_Line; Text_IO.Put_Line ("No service found in this document."); end if; end Parse; ----------------- -- Parse_Array -- ----------------- function Parse_Array (O : in out Object'Class; R : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter is P : Parameters.Parameter (Types.K_Array); D : Types.Definition (Types.K_Array); begin Trace ("(Parse_Array)", R); pragma Assert (R /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "complexType"); declare use type SOAP.WSDL.Schema.Binding_Style; Name : constant String := SOAP.XML.Get_Attr_Value (R, "name", False); begin -- Set array name, R is a complexType node P.Name := O.Current_Name; P.Elmt_Name := O.Elmt_Name; P.Typ := Types.Create (Name, Get_Target_Name_Space (R)); P.Length := O.Array_Length; D.Ref := Types.Create (Name, Types.NS (P.Typ)); D.E_Type := O.Array_Elements; if O.Style = SOAP.WSDL.Schema.Document then -- Check for array's element name declare E : DOM.Core.Node := R; begin while E /= null loop if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (E)) = "element" then D.E_Name := To_Unbounded_String (SOAP.XML.Get_Attr_Value (E, "name", False)); end if; E := SOAP.XML.First_Child (E); end loop; end; pragma Assert (D.E_Name /= Null_Unbounded_String); else D.E_Name := To_Unbounded_String ("item"); end if; Types.Register (D); -- Get documentation if any if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (SOAP.XML.First_Child (R))) = "annotation" then Append (P.Doc, Get_Documentation (SOAP.XML.First_Child (SOAP.XML.First_Child (R)))); end if; if not SOAP.WSDL.Is_Standard (WSDL.Types.Name (O.Array_Elements)) then -- This is not a standard type, parse it declare N : DOM.Core.Node := Look_For_Schema (R, WSDL.Types.Name (O.Array_Elements, True), Document, Look_Context'(Complex_Type => True, others => False)); begin if N = null then N := Look_For_Schema (R, WSDL.Types.Name (O.Array_Elements, True), Document, Look_Context'(Simple_Type => True, others => False)); Parameters.Append (P.P, Parse_Simple (O, N, Document)); else Parameters.Append (P.P, Parse_Record (O, N, Document)); end if; end; end if; return P; end; end Parse_Array; ------------------- -- Parse_Binding -- ------------------- procedure Parse_Binding (O : in out Object'Class; Binding : DOM.Core.Node; Document : SOAP.WSDL.Object) is N : DOM.Core.Node; begin Trace ("(Parse_Binding)", Binding); N := Get_Node (Binding, SOAP.Utils.With_NS (-NS_SOAP, "binding"), NS => True); if N = null then raise WSDL_Error with "Binding style/transport definition not found."; end if; -- Check for binding style Set_Binding_Style (O, N); -- Check for transport (only HTTP is supported) declare T : constant String := SOAP.XML.Get_Attr_Value (N, "transport"); begin if T (T'Last - 4 .. T'Last) /= "/http" then raise WSDL_Error with "Only HTTP transport supported."; end if; end; -- Read all operations declare NL : constant DOM.Core.Node_List := DOM.Core.Nodes.Child_Nodes (Binding); begin for K in 0 .. DOM.Core.Nodes.Length (NL) - 1 loop declare S : constant DOM.Core.Node := DOM.Core.Nodes.Item (NL, K); begin if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (S)) = "operation" and then not O.Exclude.Contains (SOAP.XML.Get_Attr_Value (S, "name")) then begin Parse_Operation (O, DOM.Core.Nodes.Item (NL, K), Document); exception when E : WSDL_Error => if Skip_Error then Text_IO.Put_Line (" " & SOAP.XML.Get_Attr_Value (S, "name") & " skipped : " & Exceptions.Exception_Message (E)); else raise WSDL_Error with "(" & SOAP.XML.Get_Attr_Value (S, "name") & ") " & Exceptions.Exception_Message (E); end if; end; end if; end; end loop; end; end Parse_Binding; ----------------------- -- Parse_Definitions -- ----------------------- procedure Parse_Definitions (O : in out Object'Class; Definitions : DOM.Core.Node; Document : SOAP.WSDL.Object) is pragma Unreferenced (Document); Atts : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (Definitions); begin Trace ("(Parse_Definitions)", Definitions); for K in 0 .. DOM.Core.Nodes.Length (Atts) - 1 loop declare N : constant DOM.Core.Node := DOM.Core.Nodes.Item (Atts, K); Name : constant String := DOM.Core.Nodes.Node_Name (N); Value : constant String := DOM.Core.Nodes.Node_Value (N); begin if Value = SOAP.Name_Space.SOAP_URL then NS_SOAP := +DOM.Core.Nodes.Local_Name (N); end if; if Name'Length > 5 and then Name (Name'First .. Name'First + 5) = "xmlns:" then if Value = SOAP.Name_Space.XSD_URL then O.xsd := SOAP.Name_Space.Create (Name, Value); elsif Value = SOAP.Name_Space.XSI_URL then O.xsi := SOAP.Name_Space.Create (Name, Value); elsif Value = SOAP.Name_Space.SOAPENC_URL then O.enc := SOAP.Name_Space.Create (Name, Value); elsif Value = SOAP.Name_Space.SOAPENV_URL then O.env := SOAP.Name_Space.Create (Name, Value); end if; end if; end; end loop; Register_Name_Spaces (Definitions); end Parse_Definitions; ------------------- -- Parse_Element -- ------------------- procedure Parse_Element (O : in out Object'Class; Element : DOM.Core.Node; Document : SOAP.WSDL.Object) is N : DOM.Core.Node := Element; CT_Node : DOM.Core.Node; begin Trace ("(Parse_Element)", Element); while N /= null and then DOM.Core.Nodes.Local_Name (N) /= "complexType" and then DOM.Core.Nodes.Local_Name (N) /= "simpleType" and then DOM.Core.Nodes.Local_Name (N) /= "element" loop N := SOAP.XML.First_Child (N); end loop; if N = null then raise WSDL_Error with "No element found in schema."; else CT_Node := N; end if; if DOM.Core.Nodes.Local_Name (N) = "simpleType" then Add_Parameter (O, Parse_Simple (O, CT_Node, Document)); elsif DOM.Core.Nodes.Local_Name (N) = "element" and then SOAP.XML.First_Child (N) = null then -- A reference, create the alias name -> type declare Name : constant String := SOAP.XML.Get_Attr_Value (N, "name", NS => False); Base : constant String := SOAP.XML.Get_Attr_Value (N, "type", NS => True); BNS : constant String := SOAP.Utils.NS (Base); P : Parameters.Parameter (Types.K_Derived); D : Types.Definition (Types.K_Derived); begin P.Typ := Types.Create (Base, Get_Target_Name_Space (N)); D.Ref := Types.Create (Name, SOAP.Name_Space.No_Name_Space); D.Parent := Types.Create (SOAP.Utils.No_NS (Base), (if BNS = "" then Types.NS (P.Typ) else SOAP.Name_Space.Create (BNS, SOAP.WSDL.Name_Spaces.Get (BNS)))); Types.Register (D); end; Add_Parameter (O, Parse_Parameter (O, N, Document)); else -- This is a complexType, continue analyse declare Parent : constant DOM.Core.Node := N; ET : constant String := SOAP.XML.Get_Attr_Value (N, "type", NS => True); begin if DOM.Core.Nodes.Local_Name (N) = "element" then if ET = "" then -- Move to complexType node N := SOAP.XML.First_Child (N); else -- Get the corresponding type definition N := Look_For_Schema (N, ET, Document, Look_Context'(Complex_Type => True, others => False)); if N = null then raise WSDL_Error with "cannot find definition for element " & ET; end if; end if; end if; -- Enter complexType node N := SOAP.XML.First_Child (N); if N = null then if SOAP.XML.Get_Attr_Value (Parent, "abstract") = "true" then raise WSDL_Error with "abstract complexType not supported."; end if; end if; end; if Is_Record (O, CT_Node) then -- This is a record or composite type Add_Parameter (O, Parse_Record (O, CT_Node, Document)); elsif Is_Array (O, CT_Node) then Add_Parameter (O, Parse_Array (O, CT_Node, Document)); else declare NL : constant DOM.Core.Node_List := DOM.Core.Nodes.Child_Nodes (N); begin for K in 0 .. DOM.Core.Nodes.Length (NL) - 1 loop declare N : constant DOM.Core.Node := DOM.Core.Nodes.Item (NL, K); begin if DOM.Core.Nodes.Node_Name (N) /= "#text" then Add_Parameter (O, Parse_Parameter (O, N, Document)); end if; end; end loop; end; end if; end if; end Parse_Element; ------------------- -- Parse_Message -- ------------------- procedure Parse_Message (O : in out Object'Class; Message : DOM.Core.Node; Document : SOAP.WSDL.Object) is N : DOM.Core.Node := Message; begin Trace ("(Parse_Message)", Message); N := SOAP.XML.First_Child (N); while N /= null loop if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) /= "documentation" then Parse_Part (O, N, Document); end if; N := SOAP.XML.Next_Sibling (N); end loop; end Parse_Message; --------------------- -- Parse_Operation -- --------------------- procedure Parse_Operation (O : in out Object'Class; Operation : DOM.Core.Node; Document : SOAP.WSDL.Object) is N : DOM.Core.Node; begin Trace ("(Parse_Operation)", Operation); O.Proc := +SOAP.XML.Get_Attr_Value (Operation, "name"); N := Get_Node (Operation, SOAP.Utils.With_NS (-NS_SOAP, "operation"), NS => True); if N = null then raise WSDL_Error with "soap:operation not found."; end if; if DOM.Core.Nodes.Get_Named_Item (DOM.Core.Nodes.Attributes (N), "soapAction") = null then O.SOAPAction := +SOAP.No_SOAPAction; else O.SOAPAction := +SOAP.XML.Get_Attr_Value (N, "soapAction"); end if; -- Check whether the binding style is declared here Set_Binding_Style (O, N); N := SOAP.XML.Next_Sibling (N); -- Check that input/output is literal Parse_Encoding : declare use type SOAP.Types.Encoding_Style; use type SOAP.WSDL.Schema.Binding_Style; F : DOM.Core.Node := N; B : DOM.Core.Node; begin while F /= null loop declare N_Name : constant String := SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (F)); E : SOAP.Types.Encoding_Style; begin if N_Name in "input" | "output" then B := SOAP.XML.First_Child (F); declare U : constant String := Characters.Handling.To_Lower (SOAP.XML.Get_Attr_Value (B, "use")); begin if U = "literal" then E := SOAP.WSDL.Schema.Literal; elsif U = "encoded" then E := SOAP.WSDL.Schema.Encoded; else raise WSDL_Error with "Unknown encoding type " & U; end if; if N_Name = "input" then O.I_Encoding := E; else O.O_Encoding := E; end if; end; end if; end; F := SOAP.XML.Next_Sibling (F); end loop; -- Check for consistency, not that no toolset support -- Document/Encoded, so we reject this conbination. if (O.I_Encoding = SOAP.WSDL.Schema.Encoded or else O.O_Encoding = SOAP.WSDL.Schema.Encoded) and then O.Style = SOAP.WSDL.Schema.Document then raise WSDL_Error with "document/encoded is not supported"; end if; end Parse_Encoding; N := SOAP.XML.First_Child (N); Parse_Name_Space : declare NS_Value : constant String := SOAP.XML.Get_Attr_Value (N, "namespace"); NS_Name : constant String := (if SOAP.WSDL.Name_Spaces.Contains (NS_Value) then SOAP.WSDL.Name_Spaces.Get (NS_Value) else ""); begin if NS_Value /= "" then if NS_Name = "" then raise WSDL_Error with "Missing definition for namespace " & NS_Value; else O.Namespace := SOAP.Name_Space.Create (NS_Name, NS_Value); end if; end if; end Parse_Name_Space; N := Get_Node (SOAP.XML.First_Child (DOM.Core.Node (Document)), "portType.operation", -O.Proc); if N = null then raise WSDL_Error with "portType.operation for " & (-O.Proc) & " not found."; end if; Parse_PortType (O, N, Document); end Parse_Operation; --------------------- -- Parse_Parameter -- --------------------- function Parse_Parameter (O : in out Object'Class; N : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter is use all type SOAP.WSDL.Parameter_Type; P_Name : constant String := SOAP.XML.Get_Attr_Value (N, "name"); P_Type : constant String := SOAP.XML.Get_Attr_Value (N, "type", True); S_Min : constant String := SOAP.XML.Get_Attr_Value (N, "minOccurs", True); S_Max : constant String := SOAP.XML.Get_Attr_Value (N, "maxOccurs", True); Min : Natural; Max : Positive; Doc : Unbounded_String; D : DOM.Core.Node := N; begin Trace ("(Parse_Parameter)", N); if P_Type = "" then raise WSDL_Error with "unsupported element '" & P_Name & "' with anonymous type"; end if; Get_Min_Max (S_Min, S_Max, Min, Max); D := SOAP.XML.First_Child (N); if D /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (D)) = "annotation" then Append (Doc, Get_Documentation (SOAP.XML.First_Child (D))); end if; if (SOAP.WSDL.Is_Standard (P_Type) and then SOAP.WSDL.To_Type (P_Type) /= P_Character) or else Is_Character (N, P_Type, Document) then if Min = 1 and then Max = 1 then declare NS : constant SOAP.Name_Space.Object := SOAP.WSDL.Name_Spaces.Get (SOAP.Utils.NS (P_Type), SOAP.Name_Space.XSD); begin return (Types.K_Simple, +P_Name, O.Elmt_Name, Doc, Typ => Types.Create (SOAP.Utils.No_NS (P_Type), NS), Min => Min, Max => Max, Is_Set => False, Next => null); end; else return Parse_Set (O, N, Document); end if; elsif P_Type = "anyType" then raise WSDL_Error with "Type anyType is not supported."; else if O.Enclosing_Types.Contains (SOAP.Utils.No_NS (P_Type)) then raise WSDL_Error with "Recursive WSDL definition " & P_Type & " is not supported."; end if; declare R : DOM.Core.Node; begin R := Look_For_Schema (N, P_Type, Document, Look_Context'(Complex_Type => True, others => False)); if R = null then -- Now check for a simpleType R := Look_For_Schema (N, P_Type, Document, Look_Context'(Simple_Type => True, others => False)); if R = null then raise WSDL_Error with "types.schema definition for " & P_Type & " not found."; else O.Self.Current_Name := +P_Name; declare P : Parameters.Parameter := Parse_Simple (O, R, Document); begin P.Min := Min; P.Max := Max; return P; end; end if; end if; if Is_Array (O, R) then declare P : Parameters.Parameter := Parse_Array (O, R, Document); begin P.Name := +P_Name; P.Min := Min; P.Max := Max; return P; end; else O.Self.Current_Name := +P_Name; if Min = 1 and then Max = 1 then declare P : Parameters.Parameter := Parse_Record (O, R, Document); begin P.Min := Min; P.Max := Max; return P; end; else return Parse_Set (O, N, Document); end if; end if; end; end if; end Parse_Parameter; ---------------- -- Parse_Part -- ---------------- procedure Parse_Part (O : in out Object'Class; Part : DOM.Core.Node; Document : SOAP.WSDL.Object) is use all type SOAP.WSDL.Parameter_Type; use type SOAP.WSDL.Schema.Binding_Style; A_Type : constant String := SOAP.XML.Get_Attr_Value (Part, "type"); A_Element : constant String := SOAP.XML.Get_Attr_Value (Part, "element"); N : DOM.Core.Node; ET : Unbounded_String; begin Trace ("(Parse_Part)", Part); if O.Style = SOAP.WSDL.Schema.Document then -- for document style we use element attribute if A_Element = "" then raise WSDL_Error with "No element attribute found for part." & (if A_Type /= "" then " (type attribute not valid for document style)" else ""); else ET := +A_Element; O.Elmt_Name := ET; end if; else -- for rpc style we use the type attribute if A_Type = "" then if O.Accept_Document and then A_Element /= "" then ET := +A_Element; O.Elmt_Name := ET; else raise WSDL_Error with "No type attribute found for part." & (if A_Element /= "" then " (element attribute not valid for rpc style)" else ""); end if; else ET := +A_Type; O.Elmt_Name := Null_Unbounded_String; end if; end if; O.Current_Name := +SOAP.XML.Get_Attr_Value (Part, "name"); declare T : constant String := -ET; begin if (SOAP.WSDL.Is_Standard (T) and then SOAP.WSDL.To_Type (T) /= P_Character) or else Is_Character (Part, T, Document) then Add_Parameter (O, -O.Current_Name, T); elsif T = SOAP.Types.XML_Any_Type then raise WSDL_Error with "Type anyType is not supported."; else N := Look_For_Schema (Part, T, Document); if N = null then raise WSDL_Error with "Definition for " & T & " not found."; end if; Parse_Element (O, N, Document); end if; end; end Parse_Part; -------------------- -- Parse_PortType -- -------------------- procedure Parse_PortType (O : in out Object'Class; Operation : DOM.Core.Node; Document : SOAP.WSDL.Object) is use type SOAP.WSDL.Schema.Binding_Style; procedure Get_Element (M : DOM.Core.Node); -- Returns the element node which contains parameters for node M ----------------- -- Get_Element -- ----------------- procedure Get_Element (M : DOM.Core.Node) is N : DOM.Core.Node; Message : Unbounded_String; begin Message := +SOAP.XML.Get_Attr_Value (M, "message", False); N := Get_Node (SOAP.XML.First_Child (DOM.Core.Node (Document)), "message", -Message); if N = null then -- In this case the message reference the schema element N := Look_For_Schema (N, -Message, Document, Look_Context'(Element => True, others => False)); if N = null then raise WSDL_Error with "types.schema.element for " & (-Message) & " not found."; end if; Parse_Element (O, N, Document); else Parse_Message (O, N, Document); end if; end Get_Element; N : DOM.Core.Node; Wrapper_Name : Unbounded_String; begin Trace ("(Parse_PortType)", Operation); -- Check for documentation N := Get_Node (Operation, "documentation"); if N /= null then O.Documentation := +Get_Documentation (N); end if; -- Input parameters N := Get_Node (Operation, "input"); if N /= null then O.Mode := Input; Get_Element (N); -- Record the wrapper name for the document binding Wrapper_Name := O.Elmt_Name; end if; -- Output parameters N := Get_Node (Operation, "output"); if N /= null then O.Mode := Output; Get_Element (N); end if; -- Fault parameters N := Get_Node (Operation, "fault"); if N /= null then O.Mode := Fault; Get_Element (N); end if; if Verbose_Mode > 0 then Text_IO.New_Line; Text_IO.Put_Line ("Procedure " & (-O.Proc) & " SOAPAction:" & (-O.SOAPAction)); Text_IO.Put_Line (" Input"); Parameters.Output (O.Params (Input)); Text_IO.Put_Line (" Output"); Parameters.Output (O.Params (Output)); end if; New_Procedure (O, -O.Proc, -O.Documentation, -O.SOAPAction, (if O.Style = SOAP.WSDL.Schema.Document then -Wrapper_Name else -O.SOAPAction), O.Namespace, O.Params (Input), O.Params (Output), O.Params (Fault)); Parameters.Release (O.Params (Input)); Parameters.Release (O.Params (Output)); Parameters.Release (O.Params (Fault)); end Parse_PortType; ------------------ -- Parse_Record -- ------------------ function Parse_Record (O : in out Object'Class; R : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter is P : Parameters.Parameter (Types.K_Record); D : Types.Definition (Types.K_Record); N : DOM.Core.Node; begin Trace ("(Parse_Record)", R); pragma Assert (R /= null and then (SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "complexType" or else SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "element")); if SOAP.XML.Get_Attr_Value (R, "abstract", False) = "true" then raise WSDL_Error with "abstract record not supported"; end if; declare use type SOAP.WSDL.Schema.Binding_Style; Name : constant String := SOAP.XML.Get_Attr_Value (R, "name", False); begin -- Set record name, R is a complexType or element node P.Name := O.Current_Name; P.Elmt_Name := O.Elmt_Name; P.Typ := Types.Create (Name, Get_Target_Name_Space (R)); D.Ref := Types.Create (Name, Types.NS (P.Typ)); D.Is_Choice := False; O.Self.Enclosing_Types.Include (Name); if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "element" then -- Skip enclosing element N := SOAP.XML.First_Child (R); -- This is the case where a complexType is directly put inside -- an enclosing element. In this case, and only for the Document -- style binding, we want to set the record name to the actual -- element name and not the parameter name (Current_Name) as set -- while parsing the part. if O.Style = SOAP.WSDL.Schema.Document then P.Name := To_Unbounded_String (Name); end if; else N := R; end if; -- Enter complexType element if N /= null then N := SOAP.XML.First_Child (N); if N /= null then if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) = "choice" then D.Is_Choice := True; N := SOAP.XML.First_Child (N); elsif SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) = "annotation" then Append (P.Doc, Get_Documentation (SOAP.XML.First_Child (N))); N := SOAP.XML.Next_Sibling (N); end if; end if; end if; Types.Register (D); -- Check for empty complexType if N /= null then -- Get first element, if we have a complexContent, parse if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) = "complexContent" then N := SOAP.XML.First_Child (N); -- We have an extension, we need to inline the element -- definition here. if N /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) = "extension" then declare Base : constant String := SOAP.XML.Get_Attr_Value (N, "base", True); CT : DOM.Core.Node; begin -- Get type whose name is Base CT := Look_For_Schema (N, Base, Document, Look_Context'(Complex_Type => True, others => False)); -- Move to the sequence CT := SOAP.XML.First_Child (CT); -- Get all elements declare NL : constant DOM.Core.Node_List := DOM.Core.Nodes.Child_Nodes (CT); begin for K in 0 .. DOM.Core.Nodes.Length (NL) - 1 loop declare N : constant DOM.Core.Node := DOM.Core.Nodes.Item (NL, K); begin if DOM.Core.Nodes.Node_Name (N) /= "#text" then Parameters.Append (P.P, Parse_Parameter (O, N, Document)); end if; end; end loop; end; end; -- Move past extension node N := SOAP.XML.First_Child (N); end if; end if; -- Got to the first element node while N /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) /= "element" loop N := SOAP.XML.First_Child (N); end loop; while N /= null loop -- Check for annotation if SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) = "annotation" then Append (P.Doc, Get_Documentation (SOAP.XML.First_Child (N))); else Parameters.Append (P.P, Parse_Parameter (O, N, Document)); end if; N := SOAP.XML.Next_Sibling (N); end loop; end if; O.Enclosing_Types.Exclude (Name); return P; end; end Parse_Record; ------------------ -- Parse_Schema -- ------------------ procedure Parse_Schema (O : in out Object'Class; Root : DOM.Core.Node; XPath : String; Dir : String) is N : DOM.Core.Node := Get_Node (Root, XPath); C : DOM.Core.Node; begin while N /= null loop if DOM.Core.Nodes.Local_Name (N) = "schema" then -- Register this schema SOAP.WSDL.Schema.Register (SOAP.Name_Space.Value (Get_Target_Name_Space (N)), N); -- Look for import in this schema C := SOAP.XML.First_Child (N); while C /= null loop if DOM.Core.Nodes.Local_Name (C) = "import" then declare L : constant String := SOAP.XML.Get_Attr_Value (C, "schemaLocation"); begin if L /= "" and then (L'Length < 7 or else L (L'First .. L'First + 6) /= "http://") then -- Register the root node of the schema under the -- corresponding namespace. declare -- Handle relative paths S : constant String := GNAT.OS_Lib.Normalize_Pathname (L, Dir); N : constant DOM.Core.Node := DOM.Core.Node (SOAP.WSDL.Load (S)); begin Trace ("(Parse_Schema) " & SOAP.XML.Get_Attr_Value (C, "namespace"), SOAP.XML.First_Child (N)); SOAP.WSDL.Schema.Register (SOAP.XML.Get_Attr_Value (C, "namespace"), SOAP.XML.First_Child (N)); Register_Name_Spaces (SOAP.XML.First_Child (N)); -- Check recursively for imported schema Parse_Schema (O, N, "schema", Directories.Containing_Directory (S)); end; end if; end; end if; C := SOAP.XML.Next_Sibling (C); end loop; end if; N := SOAP.XML.Next_Sibling (N); end loop; end Parse_Schema; ------------------- -- Parse_Service -- ------------------- procedure Parse_Service (O : in out Object'Class; Service : DOM.Core.Node; Document : SOAP.WSDL.Object) is Port, N : DOM.Core.Node; Name : Unbounded_String; Root_Documentation : Unbounded_String; Documentation : Unbounded_String; Location : Unbounded_String; Binding : Unbounded_String; begin Trace ("(Parse_Service)", Service); Name := +SOAP.XML.Get_Attr_Value (Service, "name"); N := Get_Node (Service, "documentation"); if N /= null then Root_Documentation := +Get_Documentation (N); end if; N := Get_Node (SOAP.XML.First_Child (DOM.Core.Node (Document)), "portType.documentation"); if N /= null then Append (Documentation, Get_Documentation (N)); end if; Port := Get_Node (Service, "port"); if Port = null then raise WSDL_Error with "port definition not found"; end if; N := Get_Node (Port, SOAP.Utils.With_NS (-NS_SOAP, "address"), NS => True); if N /= null then Location := +SOAP.XML.Get_Attr_Value (N, "location"); end if; Start_Service (O, -Name, -Root_Documentation, -Documentation, -Location); -- Look for the right binding Binding := +SOAP.XML.Get_Attr_Value (Port, "binding", False); N := Get_Node (SOAP.XML.First_Child (DOM.Core.Node (Document)), "binding", -Binding); if N = null then raise WSDL_Error with "binding for " & (-Binding) & " not found."; end if; Parse_Binding (O, N, Document); End_Service (O, -Name); end Parse_Service; --------------- -- Parse_Set -- --------------- function Parse_Set (O : in out Object'Class; S : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter is P : Parameters.Parameter (Types.K_Array); D : Types.Definition (Types.K_Array); begin Trace ("(Parse_Set)", S); pragma Assert (S /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (S)) = "element"); declare Name : constant String := SOAP.XML.Get_Attr_Value (S, "name", False); Typ : constant String := SOAP.XML.Get_Attr_Value (S, "type", True); S_Min : constant String := SOAP.XML.Get_Attr_Value (S, "minOccurs", False); S_Max : constant String := SOAP.XML.Get_Attr_Value (S, "maxOccurs", False); NS : constant SOAP.Name_Space.Object := SOAP.WSDL.Name_Spaces.Get (SOAP.Utils.NS (Typ), Get_Target_Name_Space (S)); begin P.Name := +Name; P.Typ := Types.Create (Typ & "_Set", NS); P.Is_Set := True; P.E_Typ := Types.Create (Typ, Types.NS (P.Typ)); Get_Min_Max (S_Min, S_Max, P.Min, P.Max); if P.Min = P.Max then P.Length := P.Min; else P.Length := 0; end if; D.Ref := P.Typ; D.E_Type := P.E_Typ; Types.Register (D); if not SOAP.WSDL.Is_Standard (Typ) then -- This is not a standard type, parse it declare N : constant DOM.Core.Node := Look_For_Schema (S, Typ, Document, Look_Context'(Complex_Type => True, others => False)); begin -- ??? Right now pretend that it is a record, there is -- certainly some cases not covered here. Parameters.Append (P.P, Parse_Record (O, N, Document)); end; end if; return P; end; end Parse_Set; ------------------ -- Parse_Simple -- ------------------ function Parse_Simple (O : in out Object'Class; R : DOM.Core.Node; Document : SOAP.WSDL.Object) return Parameters.Parameter is use all type SOAP.WSDL.Parameter_Type; function Build_Derived (Name, Base : String; Constraints : WSDL.Types.Constraints_Def; N : DOM.Core.Node) return Parameters.Parameter; -- Returns the derived (from standard Ada type) type definition function Build_Enumeration (Name, Base : String; E : DOM.Core.Node) return Parameters.Parameter; -- Returns the enumeration type definition ------------------- -- Build_Derived -- ------------------- function Build_Derived (Name, Base : String; Constraints : WSDL.Types.Constraints_Def; N : DOM.Core.Node) return Parameters.Parameter is BNS : constant String := SOAP.Utils.NS (Base); P : Parameters.Parameter (Types.K_Derived); D : Types.Definition (Types.K_Derived); begin P.Name := O.Current_Name; P.Elmt_Name := O.Elmt_Name; P.Typ := Types.Create (Name, Get_Target_Name_Space (N)); D.Constraints := Constraints; D.Ref := Types.Create (Name, Types.NS (P.Typ)); D.Parent := Types.Create (SOAP.Utils.No_NS (Base), (if BNS = "" then Types.NS (P.Typ) else SOAP.Name_Space.Create (BNS, SOAP.WSDL.Name_Spaces.Get (BNS)))); Types.Register (D); return P; end Build_Derived; ----------------------- -- Build_Enumeration -- ----------------------- function Build_Enumeration (Name, Base : String; E : DOM.Core.Node) return Parameters.Parameter is pragma Unreferenced (Base); use type Types.E_Node_Access; P : Parameters.Parameter (Types.K_Enumeration); D : Types.Definition (Types.K_Enumeration); N : DOM.Core.Node := E; R : Types.E_Node_Access; begin -- ??PO R not needed above P.Name := O.Current_Name; P.Elmt_Name := O.Elmt_Name; P.Typ := Types.Create (Name, Get_Target_Name_Space (DOM.Core.Nodes.Parent_Node (E))); D.Ref := Types.Create (Name, Types.NS (P.Typ)); while N /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (E)) = "enumeration" loop declare Value : constant String := SOAP.XML.Get_Attr_Value (N, "value", False); New_Node : constant Types.E_Node_Access := new Types.E_Node' (To_Unbounded_String (Value), null); begin if R = null then D.E_Def := New_Node; else R.Next := New_Node; end if; R := New_Node; end; N := SOAP.XML.Next_Sibling (N); end loop; Types.Register (D); return P; end Build_Enumeration; N, E : DOM.Core.Node; C : WSDL.Types.Constraints_Def; Name : Unbounded_String; Base : Unbounded_String; begin Trace ("(Parse_Simple)", R); pragma Assert (R /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (R)) = "simpleType"); Name := +SOAP.XML.Get_Attr_Value (R, "name", False); -- Enter simpleType restriction N := SOAP.XML.First_Child (R); Skip_Annotation (N); Base := +SOAP.XML.Get_Attr_Value (N, "base", True); -- Check if this is an enumeration E := SOAP.XML.First_Child (N); if E /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (E)) = "enumeration" then return Build_Enumeration (-Name, -Base, E); else -- Check restrictions for this type declare R : DOM.Core.Node := SOAP.XML.First_Child (N); begin while R /= null loop declare Name : constant String := SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (R)); Value : constant String := SOAP.XML.Get_Attr_Value (R, "value", True); begin if Name = "minInclusive" then if C.Min_Exclusive /= Null_Unbounded_String then raise WSDL_Error with "Cannot specify minInclusive and minExclusive."; end if; C.Min_Inclusive := +Value; elsif Name = "minExclusive" then if C.Min_Inclusive /= Null_Unbounded_String then raise WSDL_Error with "Cannot specify minInclusive and minExclusive."; end if; C.Min_Exclusive := +Value; elsif Name = "maxInclusive" then if C.Max_Exclusive /= Null_Unbounded_String then raise WSDL_Error with "Cannot specify maxInclusive and maxExclusive."; end if; C.Max_Inclusive := +Value; elsif Name = "maxExclusive" then if C.Max_Inclusive /= Null_Unbounded_String then raise WSDL_Error with "Cannot specify maxInclusive and maxExclusive."; end if; C.Max_Exclusive := +Value; elsif Name = "pattern" then C.Pattern := +Value; elsif Name = "length" then C.Length := Natural'Value (Value); elsif Name = "minLength" then C.Min_Length := Natural'Value (Value); elsif Name = "maxLength" then C.Max_Length := Natural'Value (Value); end if; end; R := SOAP.XML.Next_Sibling (R); end loop; end; if not SOAP.WSDL.Is_Standard (-Base) or else (To_Type (-Base) = P_Character and then not Is_Character (N, -Base, Document)) then declare B : constant DOM.Core.Node := Look_For_Schema (DOM.Core.Nodes.Parent_Node (N), -Base, Document); begin if B = null then raise WSDL_Error with "Definition for " & (-Base) & " not found."; else O.No_Param := True; Parse_Element (O, B, Document); O.No_Param := False; end if; end; end if; return Build_Derived (-Name, -Base, C, N); end if; end Parse_Simple; -------------------------- -- Register_Name_Spaces -- -------------------------- procedure Register_Name_Spaces (N : DOM.Core.Node) is Atts : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (N); begin for K in 0 .. DOM.Core.Nodes.Length (Atts) - 1 loop declare N : constant DOM.Core.Node := DOM.Core.Nodes.Item (Atts, K); N_Name : constant String := DOM.Core.Nodes.Node_Name (N); begin if N_Name'Length > 6 and then N_Name (N_Name'First .. N_Name'First + 5) = "xmlns:" then -- We can have multiple prefix pointing to the same URL -- (namespace). But an URL must be unique if not SOAP.WSDL.Name_Spaces.Contains (DOM.Core.Nodes.Local_Name (N)) then SOAP.WSDL.Name_Spaces.Register (DOM.Core.Nodes.Local_Name (N), DOM.Core.Nodes.Node_Value (N)); end if; if not SOAP.WSDL.Name_Spaces.Contains (DOM.Core.Nodes.Node_Value (N)) then SOAP.WSDL.Name_Spaces.Register (DOM.Core.Nodes.Node_Value (N), DOM.Core.Nodes.Local_Name (N)); end if; end if; end; end loop; end Register_Name_Spaces; ----------------------- -- Set_Binding_Style -- ----------------------- procedure Set_Binding_Style (O : in out Object'Class; N : DOM.Core.Node) is Style : constant String := Characters.Handling.To_Lower (SOAP.XML.Get_Attr_Value (N, "style")); begin if Style = "" then null; elsif Style = "document" then if O.Accept_Document then O.Style := SOAP.WSDL.Schema.RPC; else O.Style := SOAP.WSDL.Schema.Document; end if; elsif Style = "rpc" then O.Style := SOAP.WSDL.Schema.RPC; else raise WSDL_Error with "Unknown binding style '" & Style & '''; end if; end Set_Binding_Style; --------------------- -- Skip_Annotation -- --------------------- procedure Skip_Annotation (N : in out DOM.Core.Node) is begin if N /= null and then SOAP.Utils.No_NS (DOM.Core.Nodes.Node_Name (N)) = "annotation" then N := SOAP.XML.Next_Sibling (N); end if; end Skip_Annotation; ----------- -- Style -- ----------- function Style (O : Object'Class) return SOAP.WSDL.Schema.Binding_Style is begin return O.Style; end Style; ----------- -- Trace -- ----------- procedure Trace (Message : String; N : DOM.Core.Node) is begin if Verbose_Mode = 2 then Text_IO.Put_Line (Message); if N = null then Text_IO.Put_Line (" Node is null."); else declare Name : constant String := DOM.Core.Nodes.Local_Name (N); Atts : constant DOM.Core.Named_Node_Map := DOM.Core.Nodes.Attributes (N); begin Text_IO.Put_Line (" " & Name); for K in 0 .. DOM.Core.Nodes.Length (Atts) - 1 loop Text_IO.Put (" "); declare N : constant DOM.Core.Node := DOM.Core.Nodes.Item (Atts, K); Name : constant String := DOM.Core.Nodes.Local_Name (N); Value : constant String := DOM.Core.Nodes.Node_Value (N); begin Text_IO.Put (Name & " = " & Value); end; Text_IO.New_Line; end loop; end; end if; end if; end Trace; ------------- -- Verbose -- ------------- procedure Verbose (Level : Verbose_Level := 1) is begin Verbose_Mode := Level; end Verbose; --------- -- xsd -- --------- function xsd (O : Object'Class) return SOAP.Name_Space.Object is begin return O.xsd; end xsd; --------- -- xsi -- --------- function xsi (O : Object'Class) return SOAP.Name_Space.Object is begin return O.xsi; end xsi; end WSDL2AWS.WSDL.Parser;