--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with GL.Low_Level;

private package GL.Enums is
   pragma Preelaborate;

   type Shader_Param is (Shader_Type, Delete_Status, Compile_Status,
                         Info_Log_Length, Shader_Source_Length);

   type Program_Param is (Program_Binary_Retrievable_Hint, Program_Separable,
                          Compute_Work_Group_Size, Program_Binary_Length,
                          Geometry_Vertices_Out,
                          Geometry_Input_Type, Geometry_Output_Type,
                          Active_Uniform_Block_Max_Name_Length,
                          Active_Uniform_Blocks, Delete_Status,
                          Link_Status, Validate_Status, Info_Log_Length,
                          Attached_Shaders,
                          Active_Uniforms, Active_Uniform_Max_Length,
                          Active_Attributes, Active_Attribute_Max_Length,
                          Active_Atomic_Counter_Buffers);

   type Program_Set_Param is (Program_Binary_Retrievable_Hint, Program_Separable);

   type Program_Stage_Param is (Active_Subroutines, Active_Subroutine_Uniforms,
                                Active_Subroutine_Uniform_Locations,
                                Active_Subroutine_Max_Length,
                                Active_Subroutine_Uniform_Max_Length);

   type Program_Pipeline_Param is (Active_Program,
                                   Fragment_Shader, Vertex_Shader,
                                   Validate_Status, Info_Log_Length,
                                   Geometry_Shader,
                                   Tess_Evaluation_Shader, Tess_Control_Shader);

   type Program_Interface is (Atomic_Counter_Buffer,
                              Uniform,
                              Uniform_Block,
                              Program_Input,
                              Program_Output,
                              Buffer_Variable,
                              Shader_Storage_Block,
                              Vertex_Subroutine,
                              Tess_Control_Subroutine,
                              Tess_Evaluation_Subroutine,
                              Geometry_Subroutine,
                              Fragment_Subroutine,
                              Compute_Subroutine,
                              Vertex_Subroutine_Uniform,
                              Tess_Control_Subroutine_Uniform,
                              Tess_Evaluation_Subroutine_Uniform,
                              Geometry_Subroutine_Uniform,
                              Fragment_Subroutine_Uniform,
                              Compute_Subroutine_Uniform);

   type Program_Interface_Param is (Active_Resources, Max_Name_Length,
                                    Max_Num_Active_Variables, Max_Num_Compatible_Subroutines);

   type Program_Resource_Param is (Num_Compatible_Subroutines,
                                   Compatible_Subroutines,
                                   Is_Per_Patch,
                                   Name_Length, Resource_Type,
                                   Array_Size, Offset, Block_Index,
                                   Array_Stride, Matrix_Stride, Is_Row_Major,
                                   Atomic_Counter_Buffer_Index,
                                   Buffer_Binding, Buffer_Data_Size,
                                   Num_Active_Variables, Active_Variables,
                                   Referenced_By_Vertex_Shader,
                                   Referenced_By_Tess_Control_Shader,
                                   Referenced_By_Tess_Evaluation_Shader,
                                   Referenced_By_Geometry_Shader,
                                   Referenced_By_Fragment_Shader,
                                   Referenced_By_Compute_Shader,
                                   Top_Level_Array_Size,
                                   Top_Level_Array_Stride,
                                   Location, Location_Index);

   type Program_Resource_Array is array (Positive range <>) of Program_Resource_Param;

   type Pixel_Store_Param is (Unpack_Swap_Bytes, Unpack_LSB_First,
                              Unpack_Row_Length, Unpack_Skip_Rows,
                              Unpack_Skip_Pixels, Unpack_Alignment,
                              Pack_Swap_Bytes, Pack_LSB_First, Pack_Row_Length,
                              Pack_Skip_Rows, Pack_Skip_Pixels,
                              Pack_Alignment, Pack_Skip_Images, Pack_Image_Height,
                              Unpack_Skip_Images, Unpack_Image_Height,
                              Unpack_Compressed_Block_Width, Unpack_Compressed_Block_Height,
                              Unpack_Compressed_Block_Depth, Unpack_Compressed_Block_Size,
                              Pack_Compressed_Block_Width, Pack_Compressed_Block_Height,
                              Pack_Compressed_Block_Depth, Pack_Compressed_Block_Size);
   --  Table 8.1 and 18.1 of the OpenGL specification

   type Buffer_Param is (Buffer_Immutable_Storage, Buffer_Storage_Flags,
                         Buffer_Size, Buffer_Access, Buffer_Mapped,
                         Buffer_Access_Flags, Buffer_Map_Length,
                         Buffer_Map_Offset);

   type Buffer_Pointer_Param is (Buffer_Map_Pointer);

   type Framebuffer_Param is (Default_Width, Default_Height, Default_Layers,
                              Default_Samples, Default_Fixed_Sample_Locations);

   -----------------------------------------------------------------------------

   type Framebuffer_Kind is (Read, Draw);

   type Buffer_Kind is (Parameter_Buffer,
                        Pixel_Pack_Buffer, Pixel_Unpack_Buffer, Uniform_Buffer,
                        Draw_Indirect_Buffer,
                        Shader_Storage_Buffer, Dispatch_Indirect_Buffer,
                        Query_Buffer, Atomic_Counter_Buffer);

   type Only_Depth_Buffer is (Depth_Buffer);
   type Only_Stencil_Buffer is (Stencil_Buffer);
   type Only_Depth_Stencil_Buffer is (Depth_Stencil_Buffer);
   type Only_Color_Buffer is (Color_Buffer);

private

   for Shader_Param use (Shader_Type          => 16#8B4F#,
                         Delete_Status        => 16#8B80#,
                         Compile_Status       => 16#8B81#,
                         Info_Log_Length      => 16#8B84#,
                         Shader_Source_Length => 16#8B88#);
   for Shader_Param'Size use Low_Level.Enum'Size;

   for Program_Param use (Program_Binary_Retrievable_Hint       => 16#8257#,
                          Program_Separable                     => 16#8258#,
                          Compute_Work_Group_Size               => 16#8267#,
                          Program_Binary_Length                 => 16#8741#,
                          Geometry_Vertices_Out                 => 16#8916#,
                          Geometry_Input_Type                   => 16#8917#,
                          Geometry_Output_Type                  => 16#8918#,
                          Active_Uniform_Block_Max_Name_Length  => 16#8A35#,
                          Active_Uniform_Blocks                 => 16#8A36#,
                          Delete_Status                         => 16#8B4F#,
                          Link_Status                           => 16#8B82#,
                          Validate_Status                       => 16#8B83#,
                          Info_Log_Length                       => 16#8B84#,
                          Attached_Shaders                      => 16#8B85#,
                          Active_Uniforms                       => 16#8B86#,
                          Active_Uniform_Max_Length             => 16#8B87#,
                          Active_Attributes                     => 16#8B89#,
                          Active_Attribute_Max_Length           => 16#8B8A#,
                          Active_Atomic_Counter_Buffers         => 16#92D9#);
   for Program_Param'Size use Low_Level.Enum'Size;

   for Program_Set_Param use (Program_Binary_Retrievable_Hint => 16#8257#,
                              Program_Separable               => 16#8258#);
   for Program_Set_Param'Size use Low_Level.Enum'Size;

   for Program_Stage_Param use (Active_Subroutines                   => 16#8DE5#,
                                Active_Subroutine_Uniforms           => 16#8DE6#,
                                Active_Subroutine_Uniform_Locations  => 16#8E47#,
                                Active_Subroutine_Max_Length         => 16#8E48#,
                                Active_Subroutine_Uniform_Max_Length => 16#8E49#);
   for Program_Stage_Param'Size use Low_Level.Enum'Size;

   for Program_Pipeline_Param use (Active_Program         => 16#8259#,
                                   Fragment_Shader        => 16#8B30#,
                                   Vertex_Shader          => 16#8B31#,
                                   Validate_Status        => 16#8B83#,
                                   Info_Log_Length        => 16#8B84#,
                                   Geometry_Shader        => 16#8DD9#,
                                   Tess_Evaluation_Shader => 16#8E87#,
                                   Tess_Control_Shader    => 16#8E88#);
   for Program_Pipeline_Param'Size use Low_Level.Enum'Size;

   for Program_Interface use (Atomic_Counter_Buffer              => 16#92C0#,
                              Uniform                            => 16#92E1#,
                              Uniform_Block                      => 16#92E2#,
                              Program_Input                      => 16#92E3#,
                              Program_Output                     => 16#92E4#,
                              Buffer_Variable                    => 16#92E5#,
                              Shader_Storage_Block               => 16#92E6#,
                              Vertex_Subroutine                  => 16#92E8#,
                              Tess_Control_Subroutine            => 16#92E9#,
                              Tess_Evaluation_Subroutine         => 16#92EA#,
                              Geometry_Subroutine                => 16#92EB#,
                              Fragment_Subroutine                => 16#92EC#,
                              Compute_Subroutine                 => 16#92ED#,
                              Vertex_Subroutine_Uniform          => 16#92EE#,
                              Tess_Control_Subroutine_Uniform    => 16#92EF#,
                              Tess_Evaluation_Subroutine_Uniform => 16#92F0#,
                              Geometry_Subroutine_Uniform        => 16#92F1#,
                              Fragment_Subroutine_Uniform        => 16#92F2#,
                              Compute_Subroutine_Uniform         => 16#92F3#);
   for Program_Interface'Size use Low_Level.Enum'Size;

   for Program_Interface_Param use (Active_Resources               => 16#92F5#,
                                    Max_Name_Length                => 16#92F6#,
                                    Max_Num_Active_Variables       => 16#92F7#,
                                    Max_Num_Compatible_Subroutines => 16#92F8#);
   for Program_Interface_Param'Size use Low_Level.Enum'Size;

   for Program_Resource_Param use (Num_Compatible_Subroutines           => 16#8E4A#,
                                   Compatible_Subroutines               => 16#8E4B#,
                                   Is_Per_Patch                         => 16#92E7#,
                                   Name_Length                          => 16#92F9#,
                                   Resource_Type                        => 16#92FA#,
                                   Array_Size                           => 16#92FB#,
                                   Offset                               => 16#92FC#,
                                   Block_Index                          => 16#92FD#,
                                   Array_Stride                         => 16#92FE#,
                                   Matrix_Stride                        => 16#92FF#,
                                   Is_Row_Major                         => 16#9300#,
                                   Atomic_Counter_Buffer_Index          => 16#9301#,
                                   Buffer_Binding                       => 16#9302#,
                                   Buffer_Data_Size                     => 16#9303#,
                                   Num_Active_Variables                 => 16#9304#,
                                   Active_Variables                     => 16#9305#,
                                   Referenced_By_Vertex_Shader          => 16#9306#,
                                   Referenced_By_Tess_Control_Shader    => 16#9307#,
                                   Referenced_By_Tess_Evaluation_Shader => 16#9308#,
                                   Referenced_By_Geometry_Shader        => 16#9309#,
                                   Referenced_By_Fragment_Shader        => 16#930A#,
                                   Referenced_By_Compute_Shader         => 16#930B#,
                                   Top_Level_Array_Size                 => 16#930C#,
                                   Top_Level_Array_Stride               => 16#930D#,
                                   Location                             => 16#930E#,
                                   Location_Index                       => 16#930F#);
   for Program_Resource_Param'Size use Low_Level.Enum'Size;

   for Pixel_Store_Param use (Unpack_Swap_Bytes   => 16#0CF0#,
                              Unpack_LSB_First    => 16#0CF1#,
                              Unpack_Row_Length   => 16#0CF2#,
                              Unpack_Skip_Rows    => 16#0CF3#,
                              Unpack_Skip_Pixels  => 16#0CF4#,
                              Unpack_Alignment    => 16#0CF5#,
                              Pack_Swap_Bytes     => 16#0D00#,
                              Pack_LSB_First      => 16#0D01#,
                              Pack_Row_Length     => 16#0D02#,
                              Pack_Skip_Rows      => 16#0D03#,
                              Pack_Skip_Pixels    => 16#0D04#,
                              Pack_Alignment      => 16#0D05#,
                              Pack_Skip_Images    => 16#806B#,
                              Pack_Image_Height   => 16#806C#,
                              Unpack_Skip_Images  => 16#806D#,
                              Unpack_Image_Height => 16#806E#,
                              Unpack_Compressed_Block_Width  => 16#9127#,
                              Unpack_Compressed_Block_Height => 16#9128#,
                              Unpack_Compressed_Block_Depth  => 16#9129#,
                              Unpack_Compressed_Block_Size   => 16#912A#,
                              Pack_Compressed_Block_Width  => 16#912B#,
                              Pack_Compressed_Block_Height => 16#912C#,
                              Pack_Compressed_Block_Depth  => 16#912D#,
                              Pack_Compressed_Block_Size   => 16#912E#);
   for Pixel_Store_Param'Size use Low_Level.Enum'Size;

   for Buffer_Param use (Buffer_Immutable_Storage => 16#821F#,
                         Buffer_Storage_Flags     => 16#8220#,
                         Buffer_Size              => 16#8764#,
                         Buffer_Access            => 16#88BB#,
                         Buffer_Mapped            => 16#88BC#,
                         Buffer_Access_Flags      => 16#911F#,
                         Buffer_Map_Length        => 16#9120#,
                         Buffer_Map_Offset        => 16#9121#);
   for Buffer_Param'Size use Low_Level.Enum'Size;

   for Buffer_Pointer_Param use (Buffer_Map_Pointer => 16#88BD#);
   for Buffer_Pointer_Param'Size use Low_Level.Enum'Size;

   for Framebuffer_Param use (Default_Width                  => 16#9310#,
                              Default_Height                 => 16#9311#,
                              Default_Layers                 => 16#9312#,
                              Default_Samples                => 16#9313#,
                              Default_Fixed_Sample_Locations => 16#9314#);
   for Framebuffer_Param'Size use Low_Level.Enum'Size;

   -----------------------------------------------------------------------------

   for Framebuffer_Kind use (Read => 16#8CA8#,
                             Draw => 16#8CA9#);
   for Framebuffer_Kind'Size use Low_Level.Enum'Size;

   for Buffer_Kind use (Parameter_Buffer          => 16#80EE#,
                        Pixel_Pack_Buffer         => 16#88EB#,
                        Pixel_Unpack_Buffer       => 16#88EC#,
                        Uniform_Buffer            => 16#8A11#,
                        Draw_Indirect_Buffer      => 16#8F3F#,
                        Shader_Storage_Buffer     => 16#90D2#,
                        Dispatch_Indirect_Buffer  => 16#90EE#,
                        Query_Buffer              => 16#9192#,
                        Atomic_Counter_Buffer     => 16#92C0#);
   for Buffer_Kind'Size use Low_Level.Enum'Size;

   for Only_Depth_Buffer use (Depth_Buffer => 16#1801#);
   for Only_Depth_Buffer'Size use Low_Level.Enum'Size;

   for Only_Stencil_Buffer use (Stencil_Buffer => 16#1802#);
   for Only_Stencil_Buffer'Size use Low_Level.Enum'Size;

   for Only_Depth_Stencil_Buffer use (Depth_Stencil_Buffer => 16#84F9#);
   for Only_Depth_Stencil_Buffer'Size use Low_Level.Enum'Size;

   for Only_Color_Buffer use (Color_Buffer => 16#1800#);
   for Only_Color_Buffer'Size use Low_Level.Enum'Size;

end GL.Enums;

--  SPDX-License-Identifier: Apache-2.0
--
--  Copyright (c) 2012 Felix Krause <contact@flyx.org>
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.

with GL.Low_Level;

private package GL.Enums is
   pragma Preelaborate;

   type Shader_Param is (Shader_Type, Delete_Status, Compile_Status,
                         Info_Log_Length, Shader_Source_Length);

   type Program_Param is (Program_Binary_Retrievable_Hint, Program_Separable,
                          Compute_Work_Group_Size, Program_Binary_Length,
                          Geometry_Vertices_Out,
                          Geometry_Input_Type, Geometry_Output_Type,
                          Active_Uniform_Block_Max_Name_Length,
                          Active_Uniform_Blocks, Delete_Status,
                          Link_Status, Validate_Status, Info_Log_Length,
                          Attached_Shaders,
                          Active_Uniforms, Active_Uniform_Max_Length,
                          Active_Attributes, Active_Attribute_Max_Length,
                          Active_Atomic_Counter_Buffers);

   type Program_Set_Param is (Program_Binary_Retrievable_Hint, Program_Separable);

   type Program_Pipeline_Param is (Active_Program,
                                   Fragment_Shader, Vertex_Shader,
                                   Validate_Status, Info_Log_Length,
                                   Geometry_Shader,
                                   Tess_Evaluation_Shader, Tess_Control_Shader);

   type Program_Interface is (Atomic_Counter_Buffer,
                              Uniform,
                              Uniform_Block,
                              Program_Input,
                              Program_Output,
                              Buffer_Variable,
                              Shader_Storage_Block,
                              Vertex_Subroutine,
                              Tess_Control_Subroutine,
                              Tess_Evaluation_Subroutine,
                              Geometry_Subroutine,
                              Fragment_Subroutine,
                              Compute_Subroutine,
                              Vertex_Subroutine_Uniform,
                              Tess_Control_Subroutine_Uniform,
                              Tess_Evaluation_Subroutine_Uniform,
                              Geometry_Subroutine_Uniform,
                              Fragment_Subroutine_Uniform,
                              Compute_Subroutine_Uniform);

   type Program_Interface_Param is (Active_Resources, Max_Name_Length,
                                    Max_Num_Active_Variables, Max_Num_Compatible_Subroutines);

   type Program_Resource_Param is (Num_Compatible_Subroutines,
                                   Compatible_Subroutines,
                                   Is_Per_Patch,
                                   Name_Length, Resource_Type,
                                   Array_Size, Offset, Block_Index,
                                   Array_Stride, Matrix_Stride, Is_Row_Major,
                                   Atomic_Counter_Buffer_Index,
                                   Buffer_Binding, Buffer_Data_Size,
                                   Num_Active_Variables, Active_Variables,
                                   Referenced_By_Vertex_Shader,
                                   Referenced_By_Tess_Control_Shader,
                                   Referenced_By_Tess_Evaluation_Shader,
                                   Referenced_By_Geometry_Shader,
                                   Referenced_By_Fragment_Shader,
                                   Referenced_By_Compute_Shader,
                                   Top_Level_Array_Size,
                                   Top_Level_Array_Stride,
                                   Location, Location_Index);

   type Program_Resource_Array is array (Positive range <>) of Program_Resource_Param;

   type Pixel_Store_Param is (Unpack_Swap_Bytes, Unpack_LSB_First,
                              Unpack_Row_Length, Unpack_Skip_Rows,
                              Unpack_Skip_Pixels, Unpack_Alignment,
                              Pack_Swap_Bytes, Pack_LSB_First, Pack_Row_Length,
                              Pack_Skip_Rows, Pack_Skip_Pixels,
                              Pack_Alignment, Pack_Skip_Images, Pack_Image_Height,
                              Unpack_Skip_Images, Unpack_Image_Height,
                              Unpack_Compressed_Block_Width, Unpack_Compressed_Block_Height,
                              Unpack_Compressed_Block_Depth, Unpack_Compressed_Block_Size,
                              Pack_Compressed_Block_Width, Pack_Compressed_Block_Height,
                              Pack_Compressed_Block_Depth, Pack_Compressed_Block_Size);
   --  Table 8.1 and 18.1 of the OpenGL specification

   type Buffer_Param is (Buffer_Immutable_Storage, Buffer_Storage_Flags,
                         Buffer_Size, Buffer_Access, Buffer_Mapped,
                         Buffer_Access_Flags, Buffer_Map_Length,
                         Buffer_Map_Offset);

   type Buffer_Pointer_Param is (Buffer_Map_Pointer);

   type Framebuffer_Param is (Default_Width, Default_Height, Default_Layers,
                              Default_Samples, Default_Fixed_Sample_Locations);

   -----------------------------------------------------------------------------

   type Framebuffer_Kind is (Read, Draw);

   type Buffer_Kind is (Parameter_Buffer,
                        Pixel_Pack_Buffer, Pixel_Unpack_Buffer, Uniform_Buffer,
                        Draw_Indirect_Buffer,
                        Shader_Storage_Buffer, Dispatch_Indirect_Buffer,
                        Query_Buffer, Atomic_Counter_Buffer);

   type Only_Depth_Buffer is (Depth_Buffer);
   type Only_Stencil_Buffer is (Stencil_Buffer);
   type Only_Depth_Stencil_Buffer is (Depth_Stencil_Buffer);
   type Only_Color_Buffer is (Color_Buffer);

private

   for Shader_Param use (Shader_Type          => 16#8B4F#,
                         Delete_Status        => 16#8B80#,
                         Compile_Status       => 16#8B81#,
                         Info_Log_Length      => 16#8B84#,
                         Shader_Source_Length => 16#8B88#);
   for Shader_Param'Size use Low_Level.Enum'Size;

   for Program_Param use (Program_Binary_Retrievable_Hint       => 16#8257#,
                          Program_Separable                     => 16#8258#,
                          Compute_Work_Group_Size               => 16#8267#,
                          Program_Binary_Length                 => 16#8741#,
                          Geometry_Vertices_Out                 => 16#8916#,
                          Geometry_Input_Type                   => 16#8917#,
                          Geometry_Output_Type                  => 16#8918#,
                          Active_Uniform_Block_Max_Name_Length  => 16#8A35#,
                          Active_Uniform_Blocks                 => 16#8A36#,
                          Delete_Status                         => 16#8B4F#,
                          Link_Status                           => 16#8B82#,
                          Validate_Status                       => 16#8B83#,
                          Info_Log_Length                       => 16#8B84#,
                          Attached_Shaders                      => 16#8B85#,
                          Active_Uniforms                       => 16#8B86#,
                          Active_Uniform_Max_Length             => 16#8B87#,
                          Active_Attributes                     => 16#8B89#,
                          Active_Attribute_Max_Length           => 16#8B8A#,
                          Active_Atomic_Counter_Buffers         => 16#92D9#);
   for Program_Param'Size use Low_Level.Enum'Size;

   for Program_Set_Param use (Program_Binary_Retrievable_Hint => 16#8257#,
                              Program_Separable               => 16#8258#);
   for Program_Set_Param'Size use Low_Level.Enum'Size;

   for Program_Pipeline_Param use (Active_Program         => 16#8259#,
                                   Fragment_Shader        => 16#8B30#,
                                   Vertex_Shader          => 16#8B31#,
                                   Validate_Status        => 16#8B83#,
                                   Info_Log_Length        => 16#8B84#,
                                   Geometry_Shader        => 16#8DD9#,
                                   Tess_Evaluation_Shader => 16#8E87#,
                                   Tess_Control_Shader    => 16#8E88#);
   for Program_Pipeline_Param'Size use Low_Level.Enum'Size;

   for Program_Interface use (Atomic_Counter_Buffer              => 16#92C0#,
                              Uniform                            => 16#92E1#,
                              Uniform_Block                      => 16#92E2#,
                              Program_Input                      => 16#92E3#,
                              Program_Output                     => 16#92E4#,
                              Buffer_Variable                    => 16#92E5#,
                              Shader_Storage_Block               => 16#92E6#,
                              Vertex_Subroutine                  => 16#92E8#,
                              Tess_Control_Subroutine            => 16#92E9#,
                              Tess_Evaluation_Subroutine         => 16#92EA#,
                              Geometry_Subroutine                => 16#92EB#,
                              Fragment_Subroutine                => 16#92EC#,
                              Compute_Subroutine                 => 16#92ED#,
                              Vertex_Subroutine_Uniform          => 16#92EE#,
                              Tess_Control_Subroutine_Uniform    => 16#92EF#,
                              Tess_Evaluation_Subroutine_Uniform => 16#92F0#,
                              Geometry_Subroutine_Uniform        => 16#92F1#,
                              Fragment_Subroutine_Uniform        => 16#92F2#,
                              Compute_Subroutine_Uniform         => 16#92F3#);
   for Program_Interface'Size use Low_Level.Enum'Size;

   for Program_Interface_Param use (Active_Resources               => 16#92F5#,
                                    Max_Name_Length                => 16#92F6#,
                                    Max_Num_Active_Variables       => 16#92F7#,
                                    Max_Num_Compatible_Subroutines => 16#92F8#);
   for Program_Interface_Param'Size use Low_Level.Enum'Size;

   for Program_Resource_Param use (Num_Compatible_Subroutines           => 16#8E4A#,
                                   Compatible_Subroutines               => 16#8E4B#,
                                   Is_Per_Patch                         => 16#92E7#,
                                   Name_Length                          => 16#92F9#,
                                   Resource_Type                        => 16#92FA#,
                                   Array_Size                           => 16#92FB#,
                                   Offset                               => 16#92FC#,
                                   Block_Index                          => 16#92FD#,
                                   Array_Stride                         => 16#92FE#,
                                   Matrix_Stride                        => 16#92FF#,
                                   Is_Row_Major                         => 16#9300#,
                                   Atomic_Counter_Buffer_Index          => 16#9301#,
                                   Buffer_Binding                       => 16#9302#,
                                   Buffer_Data_Size                     => 16#9303#,
                                   Num_Active_Variables                 => 16#9304#,
                                   Active_Variables                     => 16#9305#,
                                   Referenced_By_Vertex_Shader          => 16#9306#,
                                   Referenced_By_Tess_Control_Shader    => 16#9307#,
                                   Referenced_By_Tess_Evaluation_Shader => 16#9308#,
                                   Referenced_By_Geometry_Shader        => 16#9309#,
                                   Referenced_By_Fragment_Shader        => 16#930A#,
                                   Referenced_By_Compute_Shader         => 16#930B#,
                                   Top_Level_Array_Size                 => 16#930C#,
                                   Top_Level_Array_Stride               => 16#930D#,
                                   Location                             => 16#930E#,
                                   Location_Index                       => 16#930F#);
   for Program_Resource_Param'Size use Low_Level.Enum'Size;

   for Pixel_Store_Param use (Unpack_Swap_Bytes   => 16#0CF0#,
                              Unpack_LSB_First    => 16#0CF1#,
                              Unpack_Row_Length   => 16#0CF2#,
                              Unpack_Skip_Rows    => 16#0CF3#,
                              Unpack_Skip_Pixels  => 16#0CF4#,
                              Unpack_Alignment    => 16#0CF5#,
                              Pack_Swap_Bytes     => 16#0D00#,
                              Pack_LSB_First      => 16#0D01#,
                              Pack_Row_Length     => 16#0D02#,
                              Pack_Skip_Rows      => 16#0D03#,
                              Pack_Skip_Pixels    => 16#0D04#,
                              Pack_Alignment      => 16#0D05#,
                              Pack_Skip_Images    => 16#806B#,
                              Pack_Image_Height   => 16#806C#,
                              Unpack_Skip_Images  => 16#806D#,
                              Unpack_Image_Height => 16#806E#,
                              Unpack_Compressed_Block_Width  => 16#9127#,
                              Unpack_Compressed_Block_Height => 16#9128#,
                              Unpack_Compressed_Block_Depth  => 16#9129#,
                              Unpack_Compressed_Block_Size   => 16#912A#,
                              Pack_Compressed_Block_Width  => 16#912B#,
                              Pack_Compressed_Block_Height => 16#912C#,
                              Pack_Compressed_Block_Depth  => 16#912D#,
                              Pack_Compressed_Block_Size   => 16#912E#);
   for Pixel_Store_Param'Size use Low_Level.Enum'Size;

   for Buffer_Param use (Buffer_Immutable_Storage => 16#821F#,
                         Buffer_Storage_Flags     => 16#8220#,
                         Buffer_Size              => 16#8764#,
                         Buffer_Access            => 16#88BB#,
                         Buffer_Mapped            => 16#88BC#,
                         Buffer_Access_Flags      => 16#911F#,
                         Buffer_Map_Length        => 16#9120#,
                         Buffer_Map_Offset        => 16#9121#);
   for Buffer_Param'Size use Low_Level.Enum'Size;

   for Buffer_Pointer_Param use (Buffer_Map_Pointer => 16#88BD#);
   for Buffer_Pointer_Param'Size use Low_Level.Enum'Size;

   for Framebuffer_Param use (Default_Width                  => 16#9310#,
                              Default_Height                 => 16#9311#,
                              Default_Layers                 => 16#9312#,
                              Default_Samples                => 16#9313#,
                              Default_Fixed_Sample_Locations => 16#9314#);
   for Framebuffer_Param'Size use Low_Level.Enum'Size;

   -----------------------------------------------------------------------------

   for Framebuffer_Kind use (Read => 16#8CA8#,
                             Draw => 16#8CA9#);
   for Framebuffer_Kind'Size use Low_Level.Enum'Size;

   for Buffer_Kind use (Parameter_Buffer          => 16#80EE#,
                        Pixel_Pack_Buffer         => 16#88EB#,
                        Pixel_Unpack_Buffer       => 16#88EC#,
                        Uniform_Buffer            => 16#8A11#,
                        Draw_Indirect_Buffer      => 16#8F3F#,
                        Shader_Storage_Buffer     => 16#90D2#,
                        Dispatch_Indirect_Buffer  => 16#90EE#,
                        Query_Buffer              => 16#9192#,
                        Atomic_Counter_Buffer     => 16#92C0#);
   for Buffer_Kind'Size use Low_Level.Enum'Size;

   for Only_Depth_Buffer use (Depth_Buffer => 16#1801#);
   for Only_Depth_Buffer'Size use Low_Level.Enum'Size;

   for Only_Stencil_Buffer use (Stencil_Buffer => 16#1802#);
   for Only_Stencil_Buffer'Size use Low_Level.Enum'Size;

   for Only_Depth_Stencil_Buffer use (Depth_Stencil_Buffer => 16#84F9#);
   for Only_Depth_Stencil_Buffer'Size use Low_Level.Enum'Size;

   for Only_Color_Buffer use (Color_Buffer => 16#1800#);
   for Only_Color_Buffer'Size use Low_Level.Enum'Size;

end GL.Enums;

gl: Remove unused type Program_Stage_Param in package GL.Enums

Signed-off-by: onox <34c1d3d2d1347bea60a26f46574de21a7a79b6d5@gmail.com>


-----------------------------------------------------------------------
--  security-oauth-servers -- OAuth Server Authentication Support
--  Copyright (C) 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Finalization;
with Ada.Strings.Hash;
with Ada.Containers.Indefinite_Hashed_Maps;

with Util.Strings;

with Security.Auth;
with Security.Permissions;

--  == OAuth Server ==
--  OAuth server side is provided by the <tt>Security.OAuth.Servers</tt> package.
--  This package allows to implement the authorization framework described in RFC 6749
--  The OAuth 2.0 Authorization Framework.
--
--  The authorization method produce a <tt>Grant_Type</tt> object that contains the result
--  of the grant (successful or denied).  It is the responsibility of the caller to format
--  the result in JSON/XML and return it to the client.
--
--  Three important operations are defined for the OAuth 2.0 framework.
--
--  <tt>Authorize</tt> is used to obtain an authorization request.  This operation is
--  optional in the OAuth 2.0 framework since some authorization method directly return
--  the access token.  This operation is used by the "Authorization Code Grant" and the
--  "Implicit Grant".
--
--  <tt>Token</tt> is used to get the access token and optional refresh token.
--
--  <tt>Authenticate</tt> is used for the API request to verify the access token
--  and authenticate the API call.

--  Several grant types are supported.
--
--  === Application Manager ===
--  The application manager maintains the repository of applications which are known by
--  the server and which can request authorization.  Each application is identified by
--  a client identifier (represented by the <tt>client_id</tt> request parameter).
--  The application defines the authorization methods which are allowed as well as
--  the parameters to control and drive the authorization.  This includes the redirection
--  URI, the application secret, the expiration delay for the access token.
--
--  The application manager is implemented by the application server and it must
--  implement the <tt>Application_Manager</tt> interface with the <tt>Find_Application</tt>
--  method.  The <tt>Find_Application</tt> is one of the first call made during the
--  authenticate and token generation phases.
--
--  === Resource Owner Password Credentials Grant ===
--  The password grant is one of the easiest grant method to understand but it is also one
--  of the less secure.  In this grant method, the username and user password are passed in
--  the request parameter together with the application client identifier.  The realm verifies
--  the username and password and when they are correct it generates the access token with
--  an optional refresh token.
--
--    Realm : Security.OAuth.Servers.Manager;
--    Grant : Security.OAuth.Servers.Grant_Type;
--
--      Realm.Authorize (Params, Grant);
--
--  === Accessing Protected Resources ===
--  When accessing a protected resource, the API implementation will use the
--  <tt>Authenticate</tt> operation to verify the access token and get a security principal.
--  The security principal will identifies the resource owner as well as the application
--  that is doing the call.
--
--     Realm : Security.OAuth.Servers.Manager;
--     Auth  : Security.Principal_Access;
--     Token : String := ...;
--
--       Realm.Authenticate (Token, Auth);
--
--  When a security principal is returned, the access token was validated and the
--  request is granted for the application.
--
package Security.OAuth.Servers is

   Invalid_Application : exception;

   type Application is new Security.OAuth.Application with private;

   --  Check if the application has the given permission.
   function Has_Permission (App        : in Application;
                            Permission : in Security.Permissions.Permission_Index) return Boolean;

   --  Define the status of the grant.
   type Grant_Status is (Invalid_Grant, Expired_Grant, Revoked_Grant,
                         Stealed_Grant, Valid_Grant);

   --  Define the grant type.
   type Grant_Kind is (No_Grant, Access_Grant, Code_Grant,
                       Implicit_Grant, Password_Grant, Credential_Grant,
                       Extension_Grant);

   --  The <tt>Grant_Type</tt> holds the results of the authorization.
   --  When the grant is refused, the type holds information about the refusal.
   type Grant_Type is record
      --  The request grant type.
      Request : Grant_Kind := No_Grant;

      --  The response status.
      Status  : Grant_Status := Invalid_Grant;

      --  When success, the token to return.
      Token   : Ada.Strings.Unbounded.Unbounded_String;

      --  When success, the token expiration date.
      Expires : Ada.Calendar.Time;

      --  When success, the authentication principal.
      Auth    : Security.Principal_Access;

      --  When error, the type of error to return.
      Error   : Util.Strings.Name_Access;
   end record;

   type Application_Manager is limited interface;
   type Application_Manager_Access is access all Application_Manager'Class;

   --  Find the application that correspond to the given client id.
   --  The <tt>Invalid_Application</tt> exception should be raised if there is no such application.
   function Find_Application (Realm     : in Application_Manager;
                              Client_Id : in String) return Application'Class is abstract;

   type Realm_Manager is limited interface;
   type Realm_Manager_Access is access all Realm_Manager'Class;

   --  Authenticate the token and find the associated authentication principal.
   --  The access token has been verified and the token represents the identifier
   --  of the Tuple (client_id, user, session) that describes the authentication.
   --  The <tt>Authenticate</tt> procedure should look in its database (internal
   --  or external) to find the authentication principal that was granted for
   --  the token Tuple.  When the token was not found (because it was revoked),
   --  the procedure should return a null principal.  If the authentication
   --  principal can be cached, the <tt>Cacheable</tt> value should be set.
   --  In that case, the access token and authentication  principal are inserted
   --  in a cache.
   procedure Authenticate (Realm     : in out Realm_Manager;
                           Token     : in String;
                           Auth      : out Principal_Access;
                           Cacheable : out Boolean) is abstract;

   --  Create an auth token string that identifies the given principal.  The returned
   --  token will be used by <tt>Authenticate</tt> to retrieve back the principal.  The
   --  returned token does not need to be signed.  It will be inserted in the public part
   --  of the returned access token.
   function Authorize (Realm : in Realm_Manager;
                       App   : in Application'Class;
                       Scope : in String;
                       Auth  : in Principal_Access) return String is abstract;

   procedure Verify (Realm    : in Realm_Manager;
                     Username : in String;
                     Password : in String;
                     Auth     : out Principal_Access) is abstract;

   procedure Verify (Realm : in Realm_Manager;
                     Token : in String;
                     Auth  : out Principal_Access) is abstract;

   procedure Revoke (Realm : in out Realm_Manager;
                     Auth  : in Principal_Access) is abstract;

   type Auth_Manager is tagged limited private;
   type Auth_Manager_Access is access all Auth_Manager'Class;

   --  Set the auth private key.
   procedure Set_Private_Key (Manager : in out Auth_Manager;
                              Key     : in String);

   --  Set the application manager to use and and applications.
   procedure Set_Application_Manager (Manager    : in out Auth_Manager;
                                      Repository : in Application_Manager_Access);

   --  Set the realm manager to authentify users.
   procedure Set_Realm_Manager (Manager : in out Auth_Manager;
                                Realm   : in Realm_Manager_Access);

   --  Authorize the access to the protected resource by the application and for the
   --  given principal.  The resource owner has been verified and is represented by the
   --  <tt>Auth</tt> principal.  Extract from the request parameters represented by
   --  <tt>Params</tt> the application client id, the scope and the expected response type.
   --  Handle the "Authorization Code Grant" and "Implicit Grant" defined in RFC 6749.
   procedure Authorize (Realm   : in out Auth_Manager;
                        Params  : in Security.Auth.Parameters'Class;
                        Auth    : in Security.Principal_Access;
                        Grant   : out Grant_Type);

   procedure Token (Realm   : in out Auth_Manager;
                    Params  : in Security.Auth.Parameters'Class;
                    Grant   : out Grant_Type);

   --  Make the access token from the authorization code that was created by the
   --  <tt>Authorize</tt> operation.  Verify the client application, the redirect uri, the
   --  client secret and the validity of the authorization code.  Extract from the
   --  authorization code the auth principal that was used for the grant and make the
   --  access token.
   procedure Token_From_Code (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Grant   : out Grant_Type);

   procedure Authorize_Code (Realm   : in out Auth_Manager;
                             App     : in Application'Class;
                             Params  : in Security.Auth.Parameters'Class;
                             Auth    : in Security.Principal_Access;
                             Grant   : out Grant_Type);

   procedure Authorize_Token (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Auth    : in Security.Principal_Access;
                              Grant   : out Grant_Type);

   --  Make the access token from the resource owner password credentials.  The username,
   --  password and scope are extracted from the request and they are verified through the
   --  <tt>Verify</tt> procedure to obtain an associated principal.  When successful, the
   --  principal describes the authorization and it is used to forge the access token.
   --  This operation implements the RFC 6749: 4.3.  Resource Owner Password Credentials Grant.
   procedure Token_From_Password (Realm   : in out Auth_Manager;
                                  App     : in Application'Class;
                                  Params  : in Security.Auth.Parameters'Class;
                                  Grant   : out Grant_Type);

   --  RFC 6749: 5.  Issuing an Access Token
   procedure Create_Token (Realm  : in Auth_Manager;
                           Ident  : in String;
                           Grant  : in out Grant_Type);

   --  Authenticate the access token and get a security principal that identifies the app/user.
   --  See RFC 6749, 7.  Accessing Protected Resources.
   --  The access token is first searched in the cache.  If it was found, it means the access
   --  token was already verified in the past, it is granted and associated with a principal.
   --  Otherwise, we have to verify the token signature first, then the expiration date and
   --  we extract from the token public part the auth identification.  The <tt>Authenticate</tt>
   --  operation is then called to obtain the principal from the auth identification.
   --  When access token is invalid or authentification cannot be verified, a null principal
   --  is returned.  The <tt>Grant</tt> data will hold the result of the grant with the reason
   --  of failures (if any).
   procedure Authenticate (Realm : in out Auth_Manager;
                           Token : in String;
                           Grant : out Grant_Type);

   procedure Revoke (Realm     : in out Auth_Manager;
                     Token     : in String);

private

   use Ada.Strings.Unbounded;

   function Format_Expire (Expire : in Ada.Calendar.Time) return String;

   type Application is new Security.OAuth.Application with record
      Expire_Timeout : Duration;
      Permissions    : Security.Permissions.Permission_Index_Set := Security.Permissions.EMPTY_SET;
   end record;

   type Cache_Entry is record
      Expire : Ada.Calendar.Time;
      Auth   : Principal_Access;
   end record;

   package Cache_Map is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Cache_Entry,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=",
                                                "="             => "=");

   --  The access token cache is used to speed up the access token verification
   --  when a request to a protected resource is made.
   protected type Token_Cache is

      procedure Authenticate (Token : in String;
                              Grant : in out Grant_Type);

      procedure Insert (Token     : in String;
                        Expire    : in Ada.Calendar.Time;
                        Principal : in Principal_Access);

      procedure Remove (Token : in String);

      procedure Timeout;

   private
      Entries : Cache_Map.Map;
   end Token_Cache;

   type Auth_Manager is new Ada.Finalization.Limited_Controlled with record
      --  The repository of applications.
      Repository  : Application_Manager_Access;

      --  The realm for user authentication.
      Realm       : Realm_Manager_Access;

      --  The server private key used by the HMAC signature.
      Private_Key : Ada.Strings.Unbounded.Unbounded_String;

      --  The access token cache.
      Cache       : Token_Cache;

      --  The expiration time for the generated authorization code.
      Expire_Code : Duration := 300.0;
   end record;

   --  <expiration>.<client_id>.<auth-ident>.hmac(<public>.<private-key>)
   type Token_Validity is record
      Status       : Grant_Status := Invalid_Grant;
      Ident_Start  : Natural := 0;
      Ident_End    : Natural := 0;
      Expire       : Ada.Calendar.Time;
   end record;

   function Validate (Realm     : in Auth_Manager;
                      Client_Id : in String;
                      Token     : in String) return Token_Validity;

end Security.OAuth.Servers;

-----------------------------------------------------------------------
--  security-oauth-servers -- OAuth Server Authentication Support
--  Copyright (C) 2016, 2017 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------
with Ada.Strings.Unbounded;
with Ada.Calendar;
with Ada.Finalization;
with Ada.Strings.Hash;
with Ada.Containers.Indefinite_Hashed_Maps;

with Util.Strings;

with Security.Auth;
with Security.Permissions;

--  == OAuth Server ==
--  OAuth server side is provided by the <tt>Security.OAuth.Servers</tt> package.
--  This package allows to implement the authorization framework described in RFC 6749
--  The OAuth 2.0 Authorization Framework.
--
--  The authorization method produce a <tt>Grant_Type</tt> object that contains the result
--  of the grant (successful or denied).  It is the responsibility of the caller to format
--  the result in JSON/XML and return it to the client.
--
--  Three important operations are defined for the OAuth 2.0 framework.
--
--  <tt>Authorize</tt> is used to obtain an authorization request.  This operation is
--  optional in the OAuth 2.0 framework since some authorization method directly return
--  the access token.  This operation is used by the "Authorization Code Grant" and the
--  "Implicit Grant".
--
--  <tt>Token</tt> is used to get the access token and optional refresh token.
--
--  <tt>Authenticate</tt> is used for the API request to verify the access token
--  and authenticate the API call.

--  Several grant types are supported.
--
--  === Application Manager ===
--  The application manager maintains the repository of applications which are known by
--  the server and which can request authorization.  Each application is identified by
--  a client identifier (represented by the <tt>client_id</tt> request parameter).
--  The application defines the authorization methods which are allowed as well as
--  the parameters to control and drive the authorization.  This includes the redirection
--  URI, the application secret, the expiration delay for the access token.
--
--  The application manager is implemented by the application server and it must
--  implement the <tt>Application_Manager</tt> interface with the <tt>Find_Application</tt>
--  method.  The <tt>Find_Application</tt> is one of the first call made during the
--  authenticate and token generation phases.
--
--  === Resource Owner Password Credentials Grant ===
--  The password grant is one of the easiest grant method to understand but it is also one
--  of the less secure.  In this grant method, the username and user password are passed in
--  the request parameter together with the application client identifier.  The realm verifies
--  the username and password and when they are correct it generates the access token with
--  an optional refresh token.
--
--    Realm : Security.OAuth.Servers.Manager;
--    Grant : Security.OAuth.Servers.Grant_Type;
--
--      Realm.Authorize (Params, Grant);
--
--  === Accessing Protected Resources ===
--  When accessing a protected resource, the API implementation will use the
--  <tt>Authenticate</tt> operation to verify the access token and get a security principal.
--  The security principal will identifies the resource owner as well as the application
--  that is doing the call.
--
--     Realm : Security.OAuth.Servers.Manager;
--     Auth  : Security.Principal_Access;
--     Token : String := ...;
--
--       Realm.Authenticate (Token, Auth);
--
--  When a security principal is returned, the access token was validated and the
--  request is granted for the application.
--
package Security.OAuth.Servers is

   Invalid_Application : exception;

   type Application is new Security.OAuth.Application with private;

   --  Check if the application has the given permission.
   function Has_Permission (App        : in Application;
                            Permission : in Security.Permissions.Permission_Index) return Boolean;

   --  Define the status of the grant.
   type Grant_Status is (Invalid_Grant, Expired_Grant, Revoked_Grant,
                         Stealed_Grant, Valid_Grant);

   --  Define the grant type.
   type Grant_Kind is (No_Grant, Access_Grant, Code_Grant,
                       Implicit_Grant, Password_Grant, Credential_Grant,
                       Extension_Grant);

   --  The <tt>Grant_Type</tt> holds the results of the authorization.
   --  When the grant is refused, the type holds information about the refusal.
   type Grant_Type is record
      --  The request grant type.
      Request : Grant_Kind := No_Grant;

      --  The response status.
      Status  : Grant_Status := Invalid_Grant;

      --  When success, the token to return.
      Token   : Ada.Strings.Unbounded.Unbounded_String;

      --  When success, the token expiration date.
      Expires : Ada.Calendar.Time;

      --  When success, the authentication principal.
      Auth    : Security.Principal_Access;

      --  When error, the type of error to return.
      Error   : Util.Strings.Name_Access;
   end record;

   type Application_Manager is limited interface;
   type Application_Manager_Access is access all Application_Manager'Class;

   --  Find the application that correspond to the given client id.
   --  The <tt>Invalid_Application</tt> exception should be raised if there is no such application.
   function Find_Application (Realm     : in Application_Manager;
                              Client_Id : in String) return Application'Class is abstract;

   type Realm_Manager is limited interface;
   type Realm_Manager_Access is access all Realm_Manager'Class;

   --  Authenticate the token and find the associated authentication principal.
   --  The access token has been verified and the token represents the identifier
   --  of the Tuple (client_id, user, session) that describes the authentication.
   --  The <tt>Authenticate</tt> procedure should look in its database (internal
   --  or external) to find the authentication principal that was granted for
   --  the token Tuple.  When the token was not found (because it was revoked),
   --  the procedure should return a null principal.  If the authentication
   --  principal can be cached, the <tt>Cacheable</tt> value should be set.
   --  In that case, the access token and authentication  principal are inserted
   --  in a cache.
   procedure Authenticate (Realm     : in out Realm_Manager;
                           Token     : in String;
                           Auth      : out Principal_Access;
                           Cacheable : out Boolean) is abstract;

   --  Create an auth token string that identifies the given principal.  The returned
   --  token will be used by <tt>Authenticate</tt> to retrieve back the principal.  The
   --  returned token does not need to be signed.  It will be inserted in the public part
   --  of the returned access token.
   function Authorize (Realm : in Realm_Manager;
                       App   : in Application'Class;
                       Scope : in String;
                       Auth  : in Principal_Access) return String is abstract;

   procedure Verify (Realm    : in out Realm_Manager;
                     Username : in String;
                     Password : in String;
                     Auth     : out Principal_Access) is abstract;

   procedure Verify (Realm : in out Realm_Manager;
                     Token : in String;
                     Auth  : out Principal_Access) is abstract;

   procedure Revoke (Realm : in out Realm_Manager;
                     Auth  : in Principal_Access) is abstract;

   type Auth_Manager is tagged limited private;
   type Auth_Manager_Access is access all Auth_Manager'Class;

   --  Set the auth private key.
   procedure Set_Private_Key (Manager : in out Auth_Manager;
                              Key     : in String);

   --  Set the application manager to use and and applications.
   procedure Set_Application_Manager (Manager    : in out Auth_Manager;
                                      Repository : in Application_Manager_Access);

   --  Set the realm manager to authentify users.
   procedure Set_Realm_Manager (Manager : in out Auth_Manager;
                                Realm   : in Realm_Manager_Access);

   --  Authorize the access to the protected resource by the application and for the
   --  given principal.  The resource owner has been verified and is represented by the
   --  <tt>Auth</tt> principal.  Extract from the request parameters represented by
   --  <tt>Params</tt> the application client id, the scope and the expected response type.
   --  Handle the "Authorization Code Grant" and "Implicit Grant" defined in RFC 6749.
   procedure Authorize (Realm   : in out Auth_Manager;
                        Params  : in Security.Auth.Parameters'Class;
                        Auth    : in Security.Principal_Access;
                        Grant   : out Grant_Type);

   procedure Token (Realm   : in out Auth_Manager;
                    Params  : in Security.Auth.Parameters'Class;
                    Grant   : out Grant_Type);

   --  Make the access token from the authorization code that was created by the
   --  <tt>Authorize</tt> operation.  Verify the client application, the redirect uri, the
   --  client secret and the validity of the authorization code.  Extract from the
   --  authorization code the auth principal that was used for the grant and make the
   --  access token.
   procedure Token_From_Code (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Grant   : out Grant_Type);

   procedure Authorize_Code (Realm   : in out Auth_Manager;
                             App     : in Application'Class;
                             Params  : in Security.Auth.Parameters'Class;
                             Auth    : in Security.Principal_Access;
                             Grant   : out Grant_Type);

   procedure Authorize_Token (Realm   : in out Auth_Manager;
                              App     : in Application'Class;
                              Params  : in Security.Auth.Parameters'Class;
                              Auth    : in Security.Principal_Access;
                              Grant   : out Grant_Type);

   --  Make the access token from the resource owner password credentials.  The username,
   --  password and scope are extracted from the request and they are verified through the
   --  <tt>Verify</tt> procedure to obtain an associated principal.  When successful, the
   --  principal describes the authorization and it is used to forge the access token.
   --  This operation implements the RFC 6749: 4.3.  Resource Owner Password Credentials Grant.
   procedure Token_From_Password (Realm   : in out Auth_Manager;
                                  App     : in Application'Class;
                                  Params  : in Security.Auth.Parameters'Class;
                                  Grant   : out Grant_Type);

   --  RFC 6749: 5.  Issuing an Access Token
   procedure Create_Token (Realm  : in Auth_Manager;
                           Ident  : in String;
                           Grant  : in out Grant_Type);

   --  Authenticate the access token and get a security principal that identifies the app/user.
   --  See RFC 6749, 7.  Accessing Protected Resources.
   --  The access token is first searched in the cache.  If it was found, it means the access
   --  token was already verified in the past, it is granted and associated with a principal.
   --  Otherwise, we have to verify the token signature first, then the expiration date and
   --  we extract from the token public part the auth identification.  The <tt>Authenticate</tt>
   --  operation is then called to obtain the principal from the auth identification.
   --  When access token is invalid or authentification cannot be verified, a null principal
   --  is returned.  The <tt>Grant</tt> data will hold the result of the grant with the reason
   --  of failures (if any).
   procedure Authenticate (Realm : in out Auth_Manager;
                           Token : in String;
                           Grant : out Grant_Type);

   procedure Revoke (Realm     : in out Auth_Manager;
                     Token     : in String);

private

   use Ada.Strings.Unbounded;

   function Format_Expire (Expire : in Ada.Calendar.Time) return String;

   type Application is new Security.OAuth.Application with record
      Expire_Timeout : Duration;
      Permissions    : Security.Permissions.Permission_Index_Set := Security.Permissions.EMPTY_SET;
   end record;

   type Cache_Entry is record
      Expire : Ada.Calendar.Time;
      Auth   : Principal_Access;
   end record;

   package Cache_Map is
     new Ada.Containers.Indefinite_Hashed_Maps (Key_Type        => String,
                                                Element_Type    => Cache_Entry,
                                                Hash            => Ada.Strings.Hash,
                                                Equivalent_Keys => "=",
                                                "="             => "=");

   --  The access token cache is used to speed up the access token verification
   --  when a request to a protected resource is made.
   protected type Token_Cache is

      procedure Authenticate (Token : in String;
                              Grant : in out Grant_Type);

      procedure Insert (Token     : in String;
                        Expire    : in Ada.Calendar.Time;
                        Principal : in Principal_Access);

      procedure Remove (Token : in String);

      procedure Timeout;

   private
      Entries : Cache_Map.Map;
   end Token_Cache;

   type Auth_Manager is new Ada.Finalization.Limited_Controlled with record
      --  The repository of applications.
      Repository  : Application_Manager_Access;

      --  The realm for user authentication.
      Realm       : Realm_Manager_Access;

      --  The server private key used by the HMAC signature.
      Private_Key : Ada.Strings.Unbounded.Unbounded_String;

      --  The access token cache.
      Cache       : Token_Cache;

      --  The expiration time for the generated authorization code.
      Expire_Code : Duration := 300.0;
   end record;

   --  <expiration>.<client_id>.<auth-ident>.hmac(<public>.<private-key>)
   type Token_Validity is record
      Status       : Grant_Status := Invalid_Grant;
      Ident_Start  : Natural := 0;
      Ident_End    : Natural := 0;
      Expire       : Ada.Calendar.Time;
   end record;

   function Validate (Realm     : in Auth_Manager;
                      Client_Id : in String;
                      Token     : in String) return Token_Validity;

end Security.OAuth.Servers;

Update Verify to allow in out parameter for the realm


-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Unchecked_Deallocation;

package body Util.Processes.Os is

   use Util.Systems.Os;
   use type Interfaces.C.size_t;
   use type Util.Systems.Types.File_Type;

   type Pipe_Type is array (0 .. 1) of File_Type;
   procedure Close (Pipes : in out Pipe_Type);

   --  ------------------------------
   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   --  ------------------------------
   function Create_Stream (File : in File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access is
      Stream : constant Util.Streams.Raw.Raw_Stream_Access := new Util.Streams.Raw.Raw_Stream;
      Status : constant Integer := Sys_Fcntl (File, F_SETFL, FD_CLOEXEC);
      pragma Unreferenced (Status);
   begin
      Stream.Initialize (File);
      return Stream;
   end Create_Stream;

   --  ------------------------------
   --  Wait for the process to exit.
   --  ------------------------------
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is
      pragma Unreferenced (Sys, Timeout);

      use type Util.Streams.Output_Stream_Access;

      Result : Integer;
      Wpid   : Integer;
   begin
      --  Close the input stream pipe if there is one.
      if Proc.Input /= null then
         Util.Streams.Raw.Raw_Stream'Class (Proc.Input.all).Close;
      end if;

      Wpid := Sys_Waitpid (Integer (Proc.Pid), Result'Address, 0);
      if Wpid = Integer (Proc.Pid) then
         Proc.Exit_Value := Result / 256;
         if Result mod 256 /= 0 then
            Proc.Exit_Value := (Result mod 256) * 1000;
         end if;
      end if;
   end Wait;

   --  ------------------------------
   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   --  ------------------------------
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is
      pragma Unreferenced (Sys);
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      Result := Sys_Kill (Integer (Proc.Pid), Integer (Signal));
   end Stop;

   --  ------------------------------
   --  Close both ends of the pipe (used to cleanup in case or error).
   --  ------------------------------
   procedure Close (Pipes : in out Pipe_Type) is
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      if Pipes (0) /= NO_FILE then
         Result := Sys_Close (Pipes (0));
         Pipes (0) := NO_FILE;
      end if;
      if Pipes (1) /= NO_FILE then
         Result := Sys_Close (Pipes (1));
         Pipes (1) := NO_FILE;
      end if;
   end Close;

   --  ------------------------------
   --  Spawn a new process.
   --  ------------------------------
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is
      use Interfaces.C.Strings;
      use type Interfaces.C.int;

      procedure Cleanup;

      --  Suppress all checks to make sure the child process will not raise any exception.
      pragma Suppress (All_Checks);

      Result : Integer;
      pragma Unreferenced (Result);

      Stdin_Pipes   : aliased Pipe_Type := (others => NO_FILE);
      Stdout_Pipes  : aliased Pipe_Type := (others => NO_FILE);
      Stderr_Pipes  : aliased Pipe_Type := (others => NO_FILE);

      procedure Cleanup is
      begin
         Close (Stdin_Pipes);
         Close (Stdout_Pipes);
         Close (Stderr_Pipes);
      end Cleanup;

   begin
      --  Since checks are disabled, verify by hand that the argv table is correct.
      if Sys.Argv = null or else Sys.Argc < 1 or else Sys.Argv (0) = Null_Ptr then
         raise Program_Error with "Invalid process argument list";
      end if;

      --  Setup the pipes.
      if Mode = READ or Mode = READ_WRITE or Mode = READ_ALL then
         if Sys_Pipe (Stdout_Pipes'Address) /= 0 then
            raise Process_Error with "Cannot create stdout pipe";
         end if;
      end if;
      if Mode = WRITE or Mode = READ_WRITE or Mode = READ_WRITE_ALL then
         if Sys_Pipe (Stdin_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stdin pipe";
         end if;
      end if;
      if Mode = READ_ERROR then
         if Sys_Pipe (Stderr_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stderr pipe";
         end if;
      end if;

      --  Create the new process by using vfork instead of fork.  The parent process is blocked
      --  until the child executes the exec or exits.  The child process uses the same stack
      --  as the parent.
      Proc.Pid := Sys_VFork;
      if Proc.Pid = 0 then

         --  Do not use any Ada type while in the child process.

         if Proc.To_Close /= null then
            for Fd of Proc.To_Close.all loop
               Result := Sys_Close (Fd);
            end loop;
         end if;

         if Mode = READ_ALL or Mode = READ_WRITE_ALL then
            Result := Sys_Dup2 (Stdout_Pipes (1), STDERR_FILENO);
         end if;

         if Stderr_Pipes (1) /= NO_FILE then
            if Stderr_Pipes (1) /= STDERR_FILENO then
               Result := Sys_Dup2 (Stderr_Pipes (1), STDERR_FILENO);
               Result := Sys_Close (Stderr_Pipes (1));
            end if;
            Result := Sys_Close (Stderr_Pipes (0));

         elsif Sys.Err_File /= Null_Ptr then
            --  Redirect the process error to a file.
            declare
               Fd : File_Type;
            begin
               if Sys.Err_Append then
                  Fd := Sys_Open (Sys.Err_File, O_CREAT + O_WRONLY + O_APPEND, 8#644#);
               else
                  Fd := Sys_Open (Sys.Err_File, O_CREAT + O_WRONLY + O_TRUNC, 8#644#);
               end if;
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDOUT_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         if Stdout_Pipes (1) /= NO_FILE then
            if Stdout_Pipes (1) /= STDOUT_FILENO then
               Result := Sys_Dup2 (Stdout_Pipes (1), STDOUT_FILENO);
               Result := Sys_Close (Stdout_Pipes (1));
            end if;
            Result := Sys_Close (Stdout_Pipes (0));

         elsif Sys.Out_File /= Null_Ptr then
            --  Redirect the process output to a file.
            declare
               Fd : File_Type;
            begin
               if Sys.Out_Append then
                  Fd := Sys_Open (Sys.Out_File, O_CREAT + O_WRONLY + O_APPEND, 8#644#);
               else
                  Fd := Sys_Open (Sys.Out_File, O_CREAT + O_WRONLY + O_TRUNC, 8#644#);
               end if;
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDOUT_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         if Stdin_Pipes (0) /= NO_FILE then
            if Stdin_Pipes (0) /= STDIN_FILENO then
               Result := Sys_Dup2 (Stdin_Pipes (0), STDIN_FILENO);
               Result := Sys_Close (Stdin_Pipes (0));
            end if;
            Result := Sys_Close (Stdin_Pipes (1));

         elsif Sys.In_File /= Null_Ptr then
            --  Redirect the process input from a file.
            declare
               Fd : File_Type;
            begin
               Fd := Sys_Open (Sys.In_File, O_RDONLY, 8#644#);
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDIN_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         Result := Sys_Execvp (Sys.Argv (0), Sys.Argv.all);
         Sys_Exit (255);
      end if;

      --  Process creation failed, cleanup and raise an exception.
      if Proc.Pid < 0 then
         Cleanup;
         raise Process_Error with "Cannot create process";
      end if;

      if Stdin_Pipes (1) /= NO_FILE then
         Result := Sys_Close (Stdin_Pipes (0));
         Proc.Input := Create_Stream (Stdin_Pipes (1)).all'Access;
      end if;

      if Stdout_Pipes (0) /= NO_FILE then
         Result := Sys_Close (Stdout_Pipes (1));
         Proc.Output := Create_Stream (Stdout_Pipes (0)).all'Access;
      end if;

      if Stderr_Pipes (0) /= NO_FILE then
         Result := Sys_Close (Stderr_Pipes (1));
         Proc.Error := Create_Stream (Stderr_Pipes (0)).all'Access;
      end if;

   end Spawn;

   procedure Free is
     new Ada.Unchecked_Deallocation (Name => Ptr_Ptr_Array, Object => Ptr_Array);

   --  ------------------------------
   --  Append the argument to the process argument list.
   --  ------------------------------
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is
   begin
      if Sys.Argv = null then
         Sys.Argv := new Ptr_Array (0 .. 10);
      elsif Sys.Argc = Sys.Argv'Last - 1 then
         declare
            N : constant Ptr_Ptr_Array := new Ptr_Array (0 .. Sys.Argc + 32);
         begin
            N (0 .. Sys.Argc) := Sys.Argv (0 .. Sys.Argc);
            Free (Sys.Argv);
            Sys.Argv := N;
         end;
      end if;

      Sys.Argv (Sys.Argc) := Interfaces.C.Strings.New_String (Arg);
      Sys.Argc := Sys.Argc + 1;
      Sys.Argv (Sys.Argc) := Interfaces.C.Strings.Null_Ptr;
   end Append_Argument;

   --  ------------------------------
   --  Set the process input, output and error streams to redirect and use specified files.
   --  ------------------------------
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is
   begin
      if Input'Length > 0 then
         Sys.In_File := Interfaces.C.Strings.New_String (Input);
      end if;
      if Output'Length > 0 then
         Sys.Out_File   := Interfaces.C.Strings.New_String (Output);
         Sys.Out_Append := Append_Output;
      end if;
      if Error'Length > 0 then
         Sys.Err_File   := Interfaces.C.Strings.New_String (Error);
         Sys.Err_Append := Append_Error;
      end if;
      Sys.To_Close := To_Close;
   end Set_Streams;

   --  ------------------------------
   --  Deletes the storage held by the system process.
   --  ------------------------------
   overriding
   procedure Finalize (Sys : in out System_Process) is
   begin
      if Sys.Argv /= null then
         for I in Sys.Argv'Range loop
            Interfaces.C.Strings.Free (Sys.Argv (I));
         end loop;
         Free (Sys.Argv);
      end if;
      Interfaces.C.Strings.Free (Sys.In_File);
      Interfaces.C.Strings.Free (Sys.Out_File);
      Interfaces.C.Strings.Free (Sys.Err_File);
   end Finalize;

end Util.Processes.Os;

-----------------------------------------------------------------------
--  util-processes-os -- System specific and low level operations
--  Copyright (C) 2011, 2012, 2017, 2018 Stephane Carrez
--  Written by Stephane Carrez (Stephane.Carrez@gmail.com)
--
--  Licensed under the Apache License, Version 2.0 (the "License");
--  you may not use this file except in compliance with the License.
--  You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
--  Unless required by applicable law or agreed to in writing, software
--  distributed under the License is distributed on an "AS IS" BASIS,
--  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
--  See the License for the specific language governing permissions and
--  limitations under the License.
-----------------------------------------------------------------------

with Ada.Directories;
with Ada.Unchecked_Deallocation;

package body Util.Processes.Os is

   use Util.Systems.Os;
   use type Interfaces.C.size_t;
   use type Util.Systems.Types.File_Type;
   use type Ada.Directories.File_Kind;

   type Pipe_Type is array (0 .. 1) of File_Type;
   procedure Close (Pipes : in out Pipe_Type);

   --  ------------------------------
   --  Create the output stream to read/write on the process input/output.
   --  Setup the file to be closed on exec.
   --  ------------------------------
   function Create_Stream (File : in File_Type)
                           return Util.Streams.Raw.Raw_Stream_Access is
      Stream : constant Util.Streams.Raw.Raw_Stream_Access := new Util.Streams.Raw.Raw_Stream;
      Status : constant Integer := Sys_Fcntl (File, F_SETFL, FD_CLOEXEC);
      pragma Unreferenced (Status);
   begin
      Stream.Initialize (File);
      return Stream;
   end Create_Stream;

   --  ------------------------------
   --  Wait for the process to exit.
   --  ------------------------------
   overriding
   procedure Wait (Sys     : in out System_Process;
                   Proc    : in out Process'Class;
                   Timeout : in Duration) is
      pragma Unreferenced (Sys, Timeout);

      use type Util.Streams.Output_Stream_Access;

      Result : Integer;
      Wpid   : Integer;
   begin
      --  Close the input stream pipe if there is one.
      if Proc.Input /= null then
         Util.Streams.Raw.Raw_Stream'Class (Proc.Input.all).Close;
      end if;

      Wpid := Sys_Waitpid (Integer (Proc.Pid), Result'Address, 0);
      if Wpid = Integer (Proc.Pid) then
         Proc.Exit_Value := Result / 256;
         if Result mod 256 /= 0 then
            Proc.Exit_Value := (Result mod 256) * 1000;
         end if;
      end if;
   end Wait;

   --  ------------------------------
   --  Terminate the process by sending a signal on Unix and exiting the process on Windows.
   --  This operation is not portable and has a different behavior between Unix and Windows.
   --  Its intent is to stop the process.
   --  ------------------------------
   overriding
   procedure Stop (Sys    : in out System_Process;
                   Proc   : in out Process'Class;
                   Signal : in Positive := 15) is
      pragma Unreferenced (Sys);
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      Result := Sys_Kill (Integer (Proc.Pid), Integer (Signal));
   end Stop;

   --  ------------------------------
   --  Close both ends of the pipe (used to cleanup in case or error).
   --  ------------------------------
   procedure Close (Pipes : in out Pipe_Type) is
      Result : Integer;
      pragma Unreferenced (Result);
   begin
      if Pipes (0) /= NO_FILE then
         Result := Sys_Close (Pipes (0));
         Pipes (0) := NO_FILE;
      end if;
      if Pipes (1) /= NO_FILE then
         Result := Sys_Close (Pipes (1));
         Pipes (1) := NO_FILE;
      end if;
   end Close;

   procedure Prepare_Working_Directory (Sys : in out System_Process;
                                        Proc : in out Process'Class) is
      Dir : constant String := Ada.Strings.Unbounded.To_String (Proc.Dir);
   begin
      Interfaces.C.Strings.Free (Sys.Dir);
      if Dir'Length > 0 then
         if not Ada.Directories.Exists (Dir)
           or else Ada.Directories.Kind (Dir) /= Ada.Directories.Directory then
            raise Ada.Directories.Name_Error with "Invalid directory: " & Dir;
         end if;
         Sys.Dir := Interfaces.C.Strings.New_String (Dir);
      end if;
   end Prepare_Working_Directory;

   --  ------------------------------
   --  Spawn a new process.
   --  ------------------------------
   overriding
   procedure Spawn (Sys  : in out System_Process;
                    Proc : in out Process'Class;
                    Mode : in Pipe_Mode := NONE) is
      use Interfaces.C.Strings;
      use type Interfaces.C.int;

      procedure Cleanup;

      --  Suppress all checks to make sure the child process will not raise any exception.
      pragma Suppress (All_Checks);

      Result : Integer;
      pragma Unreferenced (Result);

      Stdin_Pipes   : aliased Pipe_Type := (others => NO_FILE);
      Stdout_Pipes  : aliased Pipe_Type := (others => NO_FILE);
      Stderr_Pipes  : aliased Pipe_Type := (others => NO_FILE);

      procedure Cleanup is
      begin
         Close (Stdin_Pipes);
         Close (Stdout_Pipes);
         Close (Stderr_Pipes);
      end Cleanup;

   begin
      Sys.Prepare_Working_Directory (Proc);

      --  Since checks are disabled, verify by hand that the argv table is correct.
      if Sys.Argv = null or else Sys.Argc < 1 or else Sys.Argv (0) = Null_Ptr then
         raise Program_Error with "Invalid process argument list";
      end if;

      --  Setup the pipes.
      if Mode = READ or Mode = READ_WRITE or Mode = READ_ALL then
         if Sys_Pipe (Stdout_Pipes'Address) /= 0 then
            raise Process_Error with "Cannot create stdout pipe";
         end if;
      end if;
      if Mode = WRITE or Mode = READ_WRITE or Mode = READ_WRITE_ALL then
         if Sys_Pipe (Stdin_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stdin pipe";
         end if;
      end if;
      if Mode = READ_ERROR then
         if Sys_Pipe (Stderr_Pipes'Address) /= 0 then
            Cleanup;
            raise Process_Error with "Cannot create stderr pipe";
         end if;
      end if;

      --  Create the new process by using vfork instead of fork.  The parent process is blocked
      --  until the child executes the exec or exits.  The child process uses the same stack
      --  as the parent.
      Proc.Pid := Sys_VFork;
      if Proc.Pid = 0 then

         --  Do not use any Ada type while in the child process.

         if Proc.To_Close /= null then
            for Fd of Proc.To_Close.all loop
               Result := Sys_Close (Fd);
            end loop;
         end if;

         if Mode = READ_ALL or Mode = READ_WRITE_ALL then
            Result := Sys_Dup2 (Stdout_Pipes (1), STDERR_FILENO);
         end if;

         if Stderr_Pipes (1) /= NO_FILE then
            if Stderr_Pipes (1) /= STDERR_FILENO then
               Result := Sys_Dup2 (Stderr_Pipes (1), STDERR_FILENO);
               Result := Sys_Close (Stderr_Pipes (1));
            end if;
            Result := Sys_Close (Stderr_Pipes (0));

         elsif Sys.Err_File /= Null_Ptr then
            --  Redirect the process error to a file.
            declare
               Fd : File_Type;
            begin
               if Sys.Err_Append then
                  Fd := Sys_Open (Sys.Err_File, O_CREAT + O_WRONLY + O_APPEND, 8#644#);
               else
                  Fd := Sys_Open (Sys.Err_File, O_CREAT + O_WRONLY + O_TRUNC, 8#644#);
               end if;
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDOUT_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         if Stdout_Pipes (1) /= NO_FILE then
            if Stdout_Pipes (1) /= STDOUT_FILENO then
               Result := Sys_Dup2 (Stdout_Pipes (1), STDOUT_FILENO);
               Result := Sys_Close (Stdout_Pipes (1));
            end if;
            Result := Sys_Close (Stdout_Pipes (0));

         elsif Sys.Out_File /= Null_Ptr then
            --  Redirect the process output to a file.
            declare
               Fd : File_Type;
            begin
               if Sys.Out_Append then
                  Fd := Sys_Open (Sys.Out_File, O_CREAT + O_WRONLY + O_APPEND, 8#644#);
               else
                  Fd := Sys_Open (Sys.Out_File, O_CREAT + O_WRONLY + O_TRUNC, 8#644#);
               end if;
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDOUT_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         if Stdin_Pipes (0) /= NO_FILE then
            if Stdin_Pipes (0) /= STDIN_FILENO then
               Result := Sys_Dup2 (Stdin_Pipes (0), STDIN_FILENO);
               Result := Sys_Close (Stdin_Pipes (0));
            end if;
            Result := Sys_Close (Stdin_Pipes (1));

         elsif Sys.In_File /= Null_Ptr then
            --  Redirect the process input from a file.
            declare
               Fd : File_Type;
            begin
               Fd := Sys_Open (Sys.In_File, O_RDONLY, 8#644#);
               if Fd < 0 then
                  Sys_Exit (254);
               end if;
               Result := Sys_Dup2 (Fd, STDIN_FILENO);
               Result := Sys_Close (Fd);
            end;
         end if;

         if Sys.Dir /= Null_Ptr then
            Result := Sys_Chdir (Sys.Dir);
            if Result < 0 then
               Sys_Exit (253);
            end if;
         end if;

         Result := Sys_Execvp (Sys.Argv (0), Sys.Argv.all);
         Sys_Exit (255);
      end if;

      --  Process creation failed, cleanup and raise an exception.
      if Proc.Pid < 0 then
         Cleanup;
         raise Process_Error with "Cannot create process";
      end if;

      if Stdin_Pipes (1) /= NO_FILE then
         Result := Sys_Close (Stdin_Pipes (0));
         Proc.Input := Create_Stream (Stdin_Pipes (1)).all'Access;
      end if;

      if Stdout_Pipes (0) /= NO_FILE then
         Result := Sys_Close (Stdout_Pipes (1));
         Proc.Output := Create_Stream (Stdout_Pipes (0)).all'Access;
      end if;

      if Stderr_Pipes (0) /= NO_FILE then
         Result := Sys_Close (Stderr_Pipes (1));
         Proc.Error := Create_Stream (Stderr_Pipes (0)).all'Access;
      end if;

   end Spawn;

   procedure Free is
     new Ada.Unchecked_Deallocation (Name => Ptr_Ptr_Array, Object => Ptr_Array);

   --  ------------------------------
   --  Append the argument to the process argument list.
   --  ------------------------------
   overriding
   procedure Append_Argument (Sys : in out System_Process;
                              Arg : in String) is
   begin
      if Sys.Argv = null then
         Sys.Argv := new Ptr_Array (0 .. 10);
      elsif Sys.Argc = Sys.Argv'Last - 1 then
         declare
            N : constant Ptr_Ptr_Array := new Ptr_Array (0 .. Sys.Argc + 32);
         begin
            N (0 .. Sys.Argc) := Sys.Argv (0 .. Sys.Argc);
            Free (Sys.Argv);
            Sys.Argv := N;
         end;
      end if;

      Sys.Argv (Sys.Argc) := Interfaces.C.Strings.New_String (Arg);
      Sys.Argc := Sys.Argc + 1;
      Sys.Argv (Sys.Argc) := Interfaces.C.Strings.Null_Ptr;
   end Append_Argument;

   --  ------------------------------
   --  Set the process input, output and error streams to redirect and use specified files.
   --  ------------------------------
   overriding
   procedure Set_Streams (Sys           : in out System_Process;
                          Input         : in String;
                          Output        : in String;
                          Error         : in String;
                          Append_Output : in Boolean;
                          Append_Error  : in Boolean;
                          To_Close      : in File_Type_Array_Access) is
   begin
      if Input'Length > 0 then
         Sys.In_File := Interfaces.C.Strings.New_String (Input);
      end if;
      if Output'Length > 0 then
         Sys.Out_File   := Interfaces.C.Strings.New_String (Output);
         Sys.Out_Append := Append_Output;
      end if;
      if Error'Length > 0 then
         Sys.Err_File   := Interfaces.C.Strings.New_String (Error);
         Sys.Err_Append := Append_Error;
      end if;
      Sys.To_Close := To_Close;
   end Set_Streams;

   --  ------------------------------
   --  Deletes the storage held by the system process.
   --  ------------------------------
   overriding
   procedure Finalize (Sys : in out System_Process) is
   begin
      if Sys.Argv /= null then
         for I in Sys.Argv'Range loop
            Interfaces.C.Strings.Free (Sys.Argv (I));
         end loop;
         Free (Sys.Argv);
      end if;
      Interfaces.C.Strings.Free (Sys.In_File);
      Interfaces.C.Strings.Free (Sys.Out_File);
      Interfaces.C.Strings.Free (Sys.Err_File);
      Interfaces.C.Strings.Free (Sys.Dir);
   end Finalize;

end Util.Processes.Os;

Implement Prepare_Working_Directory before the fork and use the prepared path to change the current working directory after the fork