--  dh_ada_library, helper for Ada libraries Debian maintainers
--
--  Copyright (C) 2012-2015 Nicolas Boulenguez <nicolas@debian.org>
--
--  This program is free software: you can redistribute it and/or
--  modify it under the terms of the GNU General Public License as
--  published by the Free Software Foundation, either version 3 of the
--  License, or (at your option) any later version.
--  This program is distributed in the hope that it will be useful, but
--  WITHOUT ANY WARRANTY; without even the implied warranty of
--  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
--  General Public License for more details.
--  You should have received a copy of the GNU General Public License
--  along with this program. If not, see <http://www.gnu.org/licenses/>.
--
with Ada.Characters.Handling;
with Ada.Command_Line;
with Ada.Containers.Indefinite_Hashed_Maps;
with Ada.Containers.Indefinite_Vectors;
with Ada.Directories;
with Ada.Strings.Fixed;
with Ada.Strings.Hash;
with Ada.Strings.Maps;
with Ada.Text_IO;

with GNAT.OS_Lib;
with GNAT.Regpat;

with Dh_Lib;
with Misc;
with Projects;
with String_Sets;
with String_Vectors;

procedure Dh_Ada_Library is

   --  It would be natural to process packages in parallel, but
   --  Prj relies on the filesystem state (Prj configuration is
   --  created if absent for example), and some dh_tools have side
   --  effects on other packages (dh_strip for example).

   ----------------------------------------------------------------------
   use type GNAT.Regpat.Match_Location;

   Consistency_Error : exception;
   Usage_Error       : exception;
   ----------------------------------------------------------------------
   --  String constants

   Gnatmake_Executable : aliased String := "/usr/bin/gnatmake";
   --  Gnat_Package belongs here, but must be initialized later.
   Minus_Q_Deb_Host_Multiarch : aliased String := "-qDEB_HOST_MULTIARCH";
   Deb_Host_Multiarch  : constant String := Misc.Output_Of
     ("/usr/bin/dpkg-architecture",
      (1 =>  Minus_Q_Deb_Host_Multiarch'Unchecked_Access));

   Generated_By_Header : constant String
     := "This file is generated by " & Ada.Command_Line.Command_Name
     & " during package build.";

   Space_Character_Set : constant Ada.Strings.Maps.Character_Set
     := Ada.Strings.Maps.To_Set (' ');
   Configuration_File  : constant String := "debian/ada_libraries";

   Read_Only_Permissions : aliased String := "644";
   Read_Only_Even_Root   : aliased String := "444";

   Src_Install_Dir     : constant String := "usr/share/ada/adainclude/";
   Gpr_Install_Dir     : constant String := "usr/share/gpr/";
   Ali_Install_Dir     : constant String := "usr/lib/" & Deb_Host_Multiarch
     & "/ada/adalib/";
   Lib_Install_Dir     : constant String := "usr/lib/" & Deb_Host_Multiarch
     & '/';

   Deb_Names : constant Ada.Strings.Maps.Character_Mapping
     := Ada.Strings.Maps.To_Mapping ("_", "-");

   ----------------------------------------------------------------------
   --  Types and procedures

   type Processed_Project_Record
     (Dev_Pkg_Length : Natural) is record
      Dev_Pkg        : String (1 .. Dev_Pkg_Length);
   end record;
   package Processed_Project_Maps is new Ada.Containers.Indefinite_Hashed_Maps
     (Key_Type => String,
      Element_Type => Processed_Project_Record,
      Hash => Ada.Strings.Hash,
      Equivalent_Keys => "=");

   type Argument_Group
     (Path_Length : Natural) is record
      Path        : String (1 .. Path_Length); --  including ".gpr" suffix
      Assignments : Projects.Assignment_Vectors.Vector;
   end record;

   package Argument_Group_Vectors is new Ada.Containers.Indefinite_Vectors
     (Positive, Argument_Group);

   function Package_Containing
     (Pattern : not null GNAT.OS_Lib.String_Access)
     return String;
   --  Wrapper to a dpkg-query call. "" is returned if there is no
   --  match or many matches.

   procedure Parse_Arguments
     (Groups    : in out Argument_Group_Vectors.Vector;
      Processed :    out Dh_Lib.Command_Line_Argument_Set);

   procedure List_Packages_In_Debian_Control
     (Packages_In_Control : out String_Sets.Set);

   procedure Process_Library
     (Packages_In_Control : in     String_Sets.Set;
      Processed_Projects  : in out Processed_Project_Maps.Map);

   --  Helpers for Process_Project

   procedure Install_Ali_Files
     (Dev_Pkg_Dir : in String);

   procedure Install_Project
     (Dev_Pkg            : in String;
      Dev_Pkg_Dir        : in String;
      Processed_Projects : in Processed_Project_Maps.Map);
   --  For each project imported by the build project, try to figure
   --  where it comes from. If the name matches an already processed
   --  library name, add a Depends. Else, use dpkg to find
   --  the Debian -dev package providing it. Else, output a warning.

   --  Each renaming exception is transmitted.
   procedure Append_Trampoline_Lintian_Override
     (Lib_Pkg     : in String;
      Lib_Pkg_Dir : in String;
      Soname      : in String);
   --  If the shared library declares its stack executable, which is
   --  not recommeded by the policy, add a lintian override explaining
   --  that GNAT handles exceptions with trampolines. We check the
   --  freshly built lib, since if Noact is set it may not be
   --  installed yet.
   procedure Install_Shared_Library
     (Lib_Pkg_Dir : in String;
      Soname      : in String);
   procedure Install_Shared_Object_Symbolic_Link
     (Dev_Pkg_Dir : in String;
      Soname      :    not null GNAT.OS_Lib.String_Access);
   procedure Install_Sources
     (Dev_Pkg_Dir : in String);
   procedure Install_Static_Library
     (Dev_Pkg_Dir : in String);
   --  Guess where the freshly built static archive lies, then install
   --  it. A warning is displayed if there is not exactly one file
   --  named "libNAME.a".
   procedure Run_Dh_Strip
     (Pkg : in String);
   procedure Run_Dh_Strip_For_Shared_Library
     (Lib_Pkg : in String;
      Dbg_Pkg : in String);

   function Find_Package
     (Packages_In_Control : in String_Sets.Set;
      Pattern             : in String)
     return String;
   --  If no element of Packages_In_Control matches Pattern, "" is
   --  returned. Else, the substring matching the first subexpression
   --  of the first matching element is returned.

   --  You may find use Gnat.Regpat.Quote useful.

   --  Constraint_Error is raised if Pattern does not include at least
   --  a subgroup.

   ----------------------------------------------------------------------
   --  Implementation

   procedure Append_Trampoline_Lintian_Override
     (Lib_Pkg     : in String;
      Lib_Pkg_Dir : in String;
      Soname      : in String)
   is
      use Ada.Text_IO;
      use GNAT.OS_Lib;
      use GNAT.Regpat;
      Headers     : aliased String := "--program-headers";
      Wide        : aliased String := "--wide";
      So_Path     : aliased String := Projects.Library_Dir & Soname;
      Temp_File   : String_Access;
      F           : File_Type;
      Target_Dir  : constant String
        := Lib_Pkg_Dir & "usr/share/lintian/overrides/";
      Overrides   : constant String := Target_Dir & Lib_Pkg;
      Header      : constant String := "# " & Generated_By_Header;
      Regex       : constant Pattern_Matcher := Compile
        ("^[[:space:]]*GNU_STACK[[:space:]]+(0x[[:xdigit:]]+[[:space:]]+){5}"
           & "RW(E)?[[:space:]]+0x[[:xdigit:]]+$");
      MA            : Match_Array (0 .. Paren_Count (Regex));
      Stack_Declared_Executable : Boolean;
   begin
      Misc.Capture_Output ("/usr/bin/readelf",
                           (Headers'Unchecked_Access,
                            Wide'Unchecked_Access,
                            So_Path'Unchecked_Access), Temp_File);
      Open (F, In_File, Temp_File.all);
      loop
         if End_Of_File (F) then
            Dh_Lib.Warning ("failed to parse readelf output, "
                              & "no lintian override generated. "
                              & "Please report to "
                              & Ada.Command_Line.Command_Name & " author.");
            Stack_Declared_Executable := False;
            exit;
         end if;
         Match (Regex, Get_Line (F), MA);
         if MA (0) /= No_Match then
            Stack_Declared_Executable := MA (MA'Last) /= No_Match;
            exit;
         end if;
      end loop;
      Close (F);
      Ada.Directories.Delete_File (Temp_File.all);
      Free (Temp_File);
      if not Stack_Declared_Executable then
         return;
      end if;
      Dh_Lib.Create_Path (Target_Dir);
      Dh_Lib.Verbose_Print ("Adding executable stack lintian override to "
                              & Overrides & ".");
      if Dh_Lib.Noact then
         return;
      end if;
      if Ada.Directories.Exists (Overrides) then
         if Misc.A_Line_Matches (Overrides, '^' & Quote (Header) & '$') then
            return;
         end if;
         Open (F, Append_File, Overrides);
         New_Line (F);
      else
         Create (F, Out_File, Overrides);
      end if;
      Put_Line (F, Header);
      Put_Line (F, "# GNAT uses trampolines to implement Ada exceptions.");
      Put_Line (F, "# The wildcard replaces an architecture-dependent path,");
      Put_Line (F, "# allowing this file to be installed in /usr/share.");
      --  Note the star, because this file resides in /usr/share and
      --  its content should not vary across architectures.
      Put_Line (F, Lib_Pkg & " binary: shlib-with-executable-stack usr/lib/*/"
                  & Soname);
      Close (F);
   exception
      when others =>
         if Is_Open (F) then
            Close (F);
         end if;
         if Temp_File /= null then
            Ada.Directories.Delete_File (Temp_File.all);
            Free (Temp_File);
         end if;
         raise;
   end Append_Trampoline_Lintian_Override;

   function Find_Package
     (Packages_In_Control : in String_Sets.Set;
      Pattern             : in String)
     return String
   is
      use GNAT.Regpat;
      use String_Sets;
      PM  : constant Pattern_Matcher := Compile (Pattern);
      MA  : Match_Array (0 .. Paren_Count (PM));
      Pkg : Cursor := First (Packages_In_Control);
   begin
      while Pkg /= No_Element loop
         Match (PM, Element (Pkg), MA);
         if MA (0) /= No_Match then
            return Element (Pkg) (MA (1).First .. MA (1).Last);
         end if;
         Next (Pkg);
      end loop;
      return "";
   end Find_Package;

   procedure Install_Ali_Files
     (Dev_Pkg_Dir : in String)
   is
      Target_Dir : constant String := Dev_Pkg_Dir & Ali_Install_Dir
        & Projects.Library_Name & '/';
      procedure Process (Path : in String);
      procedure Process (Path : in String) is
         Target : aliased String := Target_Dir
           & Ada.Directories.Simple_Name (Path);
      begin
         Dh_Lib.Copy_File (Path, Target);
         Dh_Lib.Do_It ("/bin/chmod", (Read_Only_Even_Root'Unchecked_Access,
                                      Target'Unchecked_Access));
      end Process;
   begin
      Dh_Lib.Create_Path (Target_Dir);
      Projects.Iterate_On_Ali_Files (Process'Access);
   end Install_Ali_Files;

   procedure Install_Project
     (Dev_Pkg            : in String;
      Dev_Pkg_Dir        : in String;
      Processed_Projects : in Processed_Project_Maps.Map)
   is
      use Ada.Text_IO;
      Target_Dir : constant String := Dev_Pkg_Dir & Gpr_Install_Dir;
      File_Name  : constant String := Target_Dir
        & Projects.Library_Name & ".gpr";
      F          : File_Type;
   begin
      Dh_Lib.Create_Path (Target_Dir);
      Dh_Lib.Verbose_Print ("Creating developer project " & File_Name);
      if Dh_Lib.Noact then return; end if;
      Create (F, Out_File, File_Name);
      Put_Line (F, "--  " & Generated_By_Header);
      Put_Line
        (F, "--  Help about Ada shared libraries in Debian may be found at");
      Put_Line
        (F, "--  https://people.debian.org/~lbrenta/debian-ada-policy.html.");
      New_Line (F);

      declare
         procedure Process (Imported_Full_File_Name : in String;
                            Imported_Library_Name   : in String);
         procedure Process (Imported_Full_File_Name : in String;
                            Imported_Library_Name   : in String) is
         begin
            if Imported_Library_Name = "" then
               Dh_Lib.Verbose_Print
                 (Projects.Library_Name & " imports "
                    & Imported_Full_File_Name & " (ignored, not a library)");
               return;
            end if;
            declare
               use Processed_Project_Maps;
               Position : constant Cursor := Find (Processed_Projects,
                                                   Imported_Library_Name);
            begin
               if Position /= No_Element then
                  --  Withed library is built from same source package.
                  Put_Line (F, "with """ & Imported_Library_Name & ".gpr"";");
                  Dh_Lib.Addsubstvar
                    (Dev_Pkg, "ada:Depends", Element (Position).Dev_Pkg,
                     "= ${binary:Version}");
                  return;
               end if;
            end;
            declare
               use String_Sets;
               Aliased_Path   : aliased String := Imported_Full_File_Name;
               Dev_Dpkg_Query : constant String
                 := Package_Containing (Aliased_Path'Unchecked_Access);
            begin
               if Dev_Dpkg_Query /= "" then
                  --  An installed package provides this project.
                  Put_Line (F, "with """ & Imported_Library_Name & ".gpr"";");
                  Dh_Lib.Addsubstvar (Dev_Pkg, "ada:Depends", Dev_Dpkg_Query);
                  return;
               end if;
            end;
            Dh_Lib.Warning (Projects.Library_Name & " imports "
                              & Imported_Full_File_Name);
            Dh_Lib.Warning
              ("Unknown by dh-ada-library and dpkg, so ignored.");
            Dh_Lib.Warning
              ("Sorting the projects may solve this issue.");
         end Process;
      begin
         Projects.Iterate_On_Imported_Projects (Process'Access);
      end;

      Put_Line (F, "library project " & Projects.Library_Name & " is");
      Put_Line (F, "   for Library_Name use """
                  & Projects.Library_Name & """;");
      Put_Line (F, "   for Library_Kind use ""dynamic"";");
      Put_Line (F, "   for Library_Dir use ""/" & Lib_Install_Dir & """;");
      Put_Line (F, "   for Source_Dirs use (""/" & Src_Install_Dir
                  & Projects.Library_Name & """);");
      Put_Line (F, "   for Library_ALI_Dir use ""/" & Ali_Install_Dir
                  & Projects.Library_Name & """;");
      Put_Line (F, "   for Externally_Built use ""True"";");

      --  Transmit -l -L options.
      declare
         procedure Process (Option : in String);
         procedure Process (Option : in String) is
            H : constant String := Ada.Strings.Fixed.Head (Option, 2);
         begin
            if H = "-l" or H = "-L" then
               if Col (F) = 1 then   --  first option
                  Put_Line (F, "   package Linker is");
                  Put (F, "      for Linker_Options use (");
               elsif Col (F) + Option'Length + 3 > 80 then
                  --  line too long
                  Put_Line (F, ",");
                  Put (F, Ada.Strings.Fixed."*" (30, ' '));
               else
                  Put (F, ", ");
               end if;
               Put (F, '"' & Option & '"');
            end if;
         end Process;
      begin
         Projects.Iterate_On_Library_Options (Process'Access);
         if Col (F) /= 1 then     --  at least a library option
            Put_Line (F, ");");
            Put_Line (F, "   end Linker;");
         end if;
      end;

      --  Transmit renamings.
      declare
         Some_Renamings : Boolean := False;
         procedure Process (Unit    : in String;
                            File    : in String;
                            Is_Body : in Boolean);
         procedure Process (Unit    : in String;
                            File    : in String;
                            Is_Body : in Boolean)
         is
         begin
            if not Some_Renamings then
               Put_Line (F, "   package Naming is");
               Some_Renamings := True;
            end if;
            Put_Line (F, "      for "
                        & (if Is_Body
                             then "Implementation"
                             else "Specification")
                               & " (""" & Unit & """)");
            Put_Line (F, "        use """ & File & """;");
         end Process;
      begin
         Projects.Iterate_On_Naming_Exceptions (Process'Access);
         if Some_Renamings then
            Put_Line (F, "   end Naming;");
         end if;
      end;

      Put_Line (F, "end " & Projects.Library_Name & ";");
      Close (F);
   exception
      when others =>
         if Is_Open (F) then Close (F); end if;
         raise;
   end Install_Project;

   procedure Install_Shared_Library
     (Lib_Pkg_Dir : in String;
      Soname      : in String)
   is
      Target_Dir : constant String := Lib_Pkg_Dir & Lib_Install_Dir;
      Target     : aliased String := Target_Dir & Soname;
   begin
      Dh_Lib.Create_Path (Target_Dir);
      Dh_Lib.Copy_File (Projects.Library_Dir & Soname, Target);
      Dh_Lib.Do_It ("/bin/chmod", (Read_Only_Permissions'Unchecked_Access,
                                   Target'Unchecked_Access));
   end Install_Shared_Library;

   procedure Install_Shared_Object_Symbolic_Link
     (Dev_Pkg_Dir : in String;
      Soname      :    not null GNAT.OS_Lib.String_Access)
   is
      Minus_Sf   : aliased String := "-sf";
      Target_Dir : constant String := Dev_Pkg_Dir & Lib_Install_Dir;
      Link_Name  : aliased String
        := Target_Dir & "lib" & Projects.Library_Name & ".so";
   begin
      Dh_Lib.Create_Path (Target_Dir);
      Dh_Lib.Do_It ("/bin/ln", (Minus_Sf'Unchecked_Access,
                                Soname,
                                Link_Name'Unchecked_Access));
   end Install_Shared_Object_Symbolic_Link;

   procedure Install_Sources
     (Dev_Pkg_Dir : in String)
   is
      Target_Dir : constant String := Dev_Pkg_Dir & Src_Install_Dir
        & Projects.Library_Name & '/';
      procedure Process (Path   : in String;
                         In_Ada : in Boolean);
      procedure Process (Path   : in String;
                         In_Ada : in Boolean) is
         pragma Unreferenced (In_Ada);
         Target : aliased String := Target_Dir
           & Ada.Directories.Simple_Name (Path);
      begin
         Dh_Lib.Copy_File (Path, Target);
         Dh_Lib.Do_It ("/bin/chmod", (Read_Only_Permissions'Unchecked_Access,
                                      Target'Unchecked_Access));
      end Process;
   begin
      Dh_Lib.Create_Path (Target_Dir);
      Projects.Iterate_On_Sources (Process'Access);
   end Install_Sources;

   procedure Install_Static_Library
     (Dev_Pkg_Dir : in String)
   is
      use Ada.Directories;
      use String_Vectors;
      Filter  : constant Filter_Type := (Ordinary_File | Directory => True,
                                         Special_File              => False);
      Archive    : constant String := "lib" & Projects.Library_Name & ".a";
      Full_DPD   : constant String := Full_Name (Dev_Pkg_Dir);
      Target_Dir : constant String := Full_DPD & '/' & Lib_Install_Dir;
      Target     : aliased String := Target_Dir & Archive;
      Matches    : Vector;
      procedure Rec (Directory_Entry : in Directory_Entry_Type);
      procedure Rec (Directory_Entry : in Directory_Entry_Type) is
      begin
         case Kind (Directory_Entry) is
            when Special_File =>
               null; pragma Assert (False);
            when Directory =>
               if Simple_Name (Directory_Entry) /= "."
                 and Simple_Name (Directory_Entry) /= ".."
                 and Full_Name (Directory_Entry) /= Full_DPD
               then
                  Search (Full_Name (Directory_Entry), "", Filter, Rec'Access);
               end if;
            when Ordinary_File =>
               if Simple_Name (Directory_Entry) = Archive then
                  Append (Matches, Full_Name (Directory_Entry));
               end if;
         end case;
      end Rec;
   begin
      Search (Current_Directory, "", Filter, Rec'Access);
      case Length (Matches) is
         when 0 =>
            Dh_Lib.Warning ("no " & Archive & " found, none installed.");
         when 1 =>
            Dh_Lib.Create_Path (Target_Dir);
            Dh_Lib.Copy_File (First_Element (Matches), Target);
            Dh_Lib.Do_It ("/bin/chmod",
                          (Read_Only_Permissions'Unchecked_Access,
                           Target'Unchecked_Access));
         when 2 .. Ada.Containers.Count_Type'Last =>
            Dh_Lib.Warning ("many " & Archive & " found, none installed.");
            for Match in 1 .. Natural (Length (Matches)) loop
               Dh_Lib.Warning ("match: " & Element (Matches, Match));
            end loop;
      end case;
   end Install_Static_Library;

   procedure List_Packages_In_Debian_Control
     (Packages_In_Control : out String_Sets.Set)
   is
      use Ada.Text_IO;
      use GNAT.Regpat;
      Pattern : constant Pattern_Matcher := Compile ("^Package: *([^ ]+)$");
      Matches : Match_Array (0 .. 1);
      File : File_Type;
   begin
      Open (File, In_File, "debian/control");
      while not End_Of_File (File) loop
         declare
            L : constant String := Get_Line (File);
         begin
            Match (Pattern, L, Matches);
            if Matches (0) /= No_Match then
               String_Sets.Insert
                 (Container => Packages_In_Control,
                  New_Item  => L (Matches (1).First .. Matches (1).Last));
            end if;
         end;
      end loop;
      Close (File);
   exception
      when others =>
         if Is_Open (File) then Close (File); end if;
         raise;
   end List_Packages_In_Debian_Control;

   function Package_Containing
     (Pattern : not null GNAT.OS_Lib.String_Access)
     return String
   is
      use Ada.Text_IO;
      use GNAT.OS_Lib;
      Temp_File   : String_Access;
      Return_Code : Integer;
      File        : File_Type;
      Search      : aliased String := "--search";
   begin
      Misc.Capture_Output ("/usr/bin/dpkg-query",
                           (Search'Unchecked_Access,
                            Pattern), Temp_File, Return_Code);
      if Return_Code = 1 then           --  No match, or failure.
         Ada.Directories.Delete_File (Temp_File.all);
         Free (Temp_File);
         return "";
      end if;
      Open (File, In_File, Temp_File.all);
      declare
         Buffer     : constant String := Get_Line (File);
         Many_Lines : constant Boolean := not End_Of_File (File);
      begin
         Close (File);
         Ada.Directories.Delete_File (Temp_File.all);
         Free (Temp_File);
         if Many_Lines then
            return "";
         else
            return Buffer (Buffer'First
                             .. Ada.Strings.Fixed.Index (Buffer, ": ") - 1);
         end if;
      end;
   exception
      when others =>
         if Temp_File /= null then
            Ada.Directories.Delete_File (Temp_File.all);
            Free (Temp_File);
         end if;
         raise;
   end Package_Containing;

   Gnat_Package : constant String
     := Package_Containing (Gnatmake_Executable'Unchecked_Access);

   procedure Process_Library
     (Packages_In_Control : in     String_Sets.Set;
      Processed_Projects  : in out Processed_Project_Maps.Map)
   is
      Name : constant String := Projects.Library_Name;
      Deb_Name : constant String := Ada.Strings.Fixed.Translate (Name,
                                                                 Deb_Names);
      Minus : constant String
        := (if Ada.Characters.Handling.Is_Decimal_Digit (Name (Name'Last))
              then "-" else  "");
      Ptn_Start : constant String := "^lib" & GNAT.Regpat.Quote (Deb_Name);
      Ptn_Version : constant String := Minus & "([0-9]+(\.[0-9]+)*)";
      Dbg_Ptn : constant String := Ptn_Start & "(" & Ptn_Version & "?-)dbg$";
      Dev_Ptn : constant String := Ptn_Start & Ptn_Version & "-dev$";
      Lib_Ptn : constant String := Ptn_Start & Ptn_Version & "$";
      Doc_Ptn : constant String := Ptn_Start & "(" & Ptn_Version & "?-)doc$";
      Lib_Vsn : constant String := Find_Package (Packages_In_Control, Lib_Ptn);
      Dev_Vsn : constant String := Find_Package (Packages_In_Control, Dev_Ptn);
      Dbg_Vsn : constant String := Find_Package (Packages_In_Control, Dbg_Ptn);
      Doc_Vsn : constant String := Find_Package (Packages_In_Control, Doc_Ptn);
      Dbg_Pkg : constant String := "lib" & Deb_Name & Dbg_Vsn & "dbg";
      Dev_Pkg : constant String := "lib" & Deb_Name & Minus & Dev_Vsn & "-dev";
      Lib_Pkg : constant String := "lib" & Deb_Name & Minus & Lib_Vsn;
      Soname : aliased  String := "lib" & Name & ".so." & Lib_Vsn;
      Dev_Pkg_Dir : constant String := "debian/" & Dev_Pkg & '/';
      Lib_Pkg_Dir : constant String := "debian/" & Lib_Pkg & '/';
   begin
      if Dev_Vsn = "" then raise Consistency_Error with
        "No package matching " & Dev_Ptn & " in debian/control.";
      elsif Lib_Vsn = "" then raise Consistency_Error with
        "No package matching " & Lib_Ptn & " in debian/control.";
      end if;
      if Dbg_Vsn /= "" then
         Dh_Lib.Warning
           ("dbgsym packages are easyer, see /u/s/doc/dh-ada-library/README.");
         if Dbg_Vsn /= "-" then
            Dh_Lib.Warning
              ("Versioned -dbg name (Coexistence Allowed is not supported).");
         end if;
      end if;
      if Doc_Vsn /= "" and Doc_Vsn /= "-" then Dh_Lib.Warning
        ("Versioned -doc name (Coexistence Allowed is not supported.");
      end if;

      Processed_Project_Maps.Insert
        (Container => Processed_Projects,
         Key => Name,
         New_Item => (Dev_Pkg'Length, Dev_Pkg));

      if String_Sets.Contains (Dh_Lib.Dopackages, Lib_Pkg) then
         Install_Shared_Library (Lib_Pkg_Dir, Soname);
         if Dbg_Vsn /= "" then
            Run_Dh_Strip_For_Shared_Library (Lib_Pkg, Dbg_Pkg);
         end if;
         Append_Trampoline_Lintian_Override (Lib_Pkg, Lib_Pkg_Dir, Soname);
         Dh_Lib.Write_Log (Binary_Package => Lib_Pkg);
      end if;
      if String_Sets.Contains (Dh_Lib.Dopackages, Dev_Pkg) then
         Install_Ali_Files (Dev_Pkg_Dir);
         Install_Sources (Dev_Pkg_Dir);
         Install_Shared_Object_Symbolic_Link (Dev_Pkg_Dir,
                                              Soname'Unchecked_Access);
         if Dbg_Vsn /= "" then
            Run_Dh_Strip (Dev_Pkg);
            --  Strip right now so that the static archive keeps its
            --  debugging information.
         end if;
         Install_Static_Library (Dev_Pkg_Dir);
         Install_Project (Dev_Pkg, Dev_Pkg_Dir, Processed_Projects);
         Dh_Lib.Addsubstvar (Dev_Pkg, "ada:Depends", "gnat");
         Dh_Lib.Addsubstvar (Dev_Pkg, "ada:Depends", Gnat_Package);
         Dh_Lib.Addsubstvar (Dev_Pkg, "ada:Depends", Lib_Pkg,
                             "= ${binary:Version}");
         Dh_Lib.Write_Log (Binary_Package => Dev_Pkg);
      end if;
      if Dbg_Vsn /= ""
        and then String_Sets.Contains (Dh_Lib.Dopackages, Dbg_Pkg)
      then
         Dh_Lib.Addsubstvar (Dbg_Pkg, "ada:Depends", Lib_Pkg,
                             "= ${binary:Version}");
         Dh_Lib.Addsubstvar (Dbg_Pkg, "ada:Recommends", Dev_Pkg,
                             "= ${binary:Version}");
         Dh_Lib.Addsubstvar (Dbg_Pkg, "ada:Suggests", "gnat");
         Dh_Lib.Write_Log (Binary_Package => Dbg_Pkg);
      end if;
   end Process_Library;

   procedure Run_Dh_Strip
     (Pkg : in String)
   is
      Pkg_Equals     : aliased String := "--package=" & Pkg;
   begin
      Dh_Lib.Do_It ("/usr/bin/dh_strip", (1 => Pkg_Equals'Unchecked_Access));
   end Run_Dh_Strip;

   procedure Run_Dh_Strip_For_Shared_Library
     (Lib_Pkg : in String;
      Dbg_Pkg : in String)
   is
      Pkg_Equals_Lib : aliased String := "--package=" & Lib_Pkg;
      Dbg_To_Pkg     : aliased String := "--dbg-package=" & Dbg_Pkg;
   begin
      if String_Sets.Contains (Dh_Lib.Dopackages, Dbg_Pkg) then
         Dh_Lib.Do_It ("/usr/bin/dh_strip",
                       (Pkg_Equals_Lib'Unchecked_Access,
                        Dbg_To_Pkg'Unchecked_Access));
      else
         Dh_Lib.Warning ("Package " & Dbg_Pkg
                           & " is not processed by debhelper,"
                           & " unable to strip shared library");
      end if;
   end Run_Dh_Strip_For_Shared_Library;

   procedure Parse_Arguments
     (Groups    : in out Argument_Group_Vectors.Vector;
      Processed :    out Dh_Lib.Command_Line_Argument_Set)
   is
      procedure Check_At_End;
      procedure Process_Argument (Argument   : in     String;
                                  Recognized :    out Boolean);
      procedure Process_Line (Buffer : in String);
      Assignments : Projects.Assignment_Vectors.Vector;

      procedure Check_At_End is
      begin
         if not Projects.Assignment_Vectors.Is_Empty (Assignments) then
            raise Usage_Error
              with " assignments must come before the project";
         end if;
      end Check_At_End;

      procedure Process_Argument (Argument   : in     String;
                                  Recognized :    out Boolean) is
         use Ada.Strings.Fixed;
         Eq : Natural;
      begin
         if Tail (Argument, 4) = ".gpr" then
            Argument_Group_Vectors.Append (Groups,
                                           (Assignments => Assignments,
                                            Path        => Argument,
                                            Path_Length => Argument'Length));
            Projects.Assignment_Vectors.Clear (Assignments);
            Recognized := True;
         else
            Eq := Index (Argument, "=");
            if Eq /= 0 then
               Projects.Assignment_Vectors.Append
                 (Assignments,
                  (Name         => Argument (Argument'First .. Eq - 1),
                   Name_Length  => Eq - Argument'First,
                   Value        => Argument (Eq + 1 .. Argument'Last),
                   Value_Length => Argument'Last - Eq));
               Recognized := True;
            else
               Recognized := False;
            end if;
         end if;
      end Process_Argument;

      procedure Process_Line (Buffer : in String) is
         use Ada.Strings.Fixed;
         First      : Natural;
         Last       : Natural := Buffer'First - 1;
         Recognized : Boolean;
      begin
         if Buffer'Length > 0 and then Buffer (Buffer'First) /= '#' then
            while Last < Buffer'Last loop
               First := Index (Buffer, Space_Character_Set, Last + 1,
                               Ada.Strings.Outside);
               exit when First = 0;
               Last := Index (Buffer, Space_Character_Set, First,
                              Ada.Strings.Inside);
               if Last = 0 then
                  Last := Buffer'Last;
               else
                  Last := Last - 1;
               end if;
               Process_Argument (Buffer (First .. Last), Recognized);
               if not Recognized then
                  raise Usage_Error
                    with Configuration_File & ": unrecognized argument "
                    & Buffer (First .. Last);
               end if;
            end loop;
         end if;
      end Process_Line;

      use Ada.Text_IO;
      File : File_Type;
   begin
      --  Command line
      for I in Processed'Range loop
         Process_Argument (Ada.Command_Line.Argument (I), Processed (I));
      end loop;
      Check_At_End;
      --  debian/ada_libraries
      if Ada.Directories.Exists (Configuration_File) then
         Open (File, In_File, Configuration_File);
         while not End_Of_File (File) loop
            Process_Line (Get_Line (File));
         end loop;
         Close (File);
         Check_At_End;
      end if;
   exception
      when others =>
         if Is_Open (File) then Close (File); end if;
         raise;
   end Parse_Arguments;

   ----------------------------------------------------------------------
   --  Main body
   use Argument_Group_Vectors;
   use String_Sets;
   Packages_In_Control : String_Sets.Set;
   Groups              : Argument_Group_Vectors.Vector;
   Processed           : Dh_Lib.Command_Line_Argument_Set;
   Processed_Projects  : Processed_Project_Maps.Map;
begin
   Parse_Arguments (Groups, Processed);
   Dh_Lib.Init (Processed);

   --  Now, usage error should have been detected, we may exit if we
   --  are certain that there is nothing to do.
   if Is_Empty (Dh_Lib.Dopackages) or Is_Empty (Groups) or Dh_Lib.Indep then
      return;
   end if;

   --  Initialize list of all packages.
   List_Packages_In_Debian_Control (Packages_In_Control);

   for Grp in 1 .. Natural (Length (Groups)) loop
      Projects.Parse (Element (Groups, Grp).Assignments,
                      Element (Groups, Grp).Path);
      if not Projects.Is_Library then
         raise Consistency_Error with
           Element (Groups, Grp).Path & ": not a library project";
      elsif not Projects.Dynamic then
         raise Consistency_Error with
           Element (Groups, Grp).Path & ": not a dynamic library";
      elsif Projects.Externally_Built then
         raise Consistency_Error with
           Element (Groups, Grp).Path & ": marked as externally build";
      end if;
      Process_Library (Packages_In_Control, Processed_Projects);
   end loop;
end Dh_Ada_Library;
