1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230 | ------------------------------------------------------------------------------
-- --
-- GPR2 PROJECT MANAGER --
-- --
-- Copyright (C) 2019-2023, AdaCore --
-- --
-- This is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
-- ware Foundation; either version 3, or (at your option) any later ver- --
-- sion. This software is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- --
-- TABILITY 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 distributed with GNAT; see file COPYING. If not, --
-- see <http://www.gnu.org/licenses/>. --
-- --
------------------------------------------------------------------------------
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Directories;
with Ada.Text_IO;
with GNAT.MD5; use GNAT.MD5;
with GNAT.OS_Lib;
with GPR2.Path_Name;
with GPRtools;
package body GPRinstall.Uninstall is
use Ada;
use Ada.Directories;
use GPR2;
package File_Set is new Containers.Indefinite_Ordered_Sets (String);
-------------
-- Process --
-------------
procedure Process
(Install_Name : String;
Options : in out GPRinstall.Options.Object)
is
use GNAT;
use GPRtools;
procedure Delete_File (Position : File_Set.Cursor);
-- Delete file pointed to by Position, do nothing if the file is not
-- found.
procedure Do_Delete (Filename : String);
-- Delete file or display a message if in dry-run mode
procedure Delete_Empty_Directory (Dir_Name : String);
-- Delete Dir_Name if empty, if removed try with parent directory
----------------------------
-- Delete_Empty_Directory --
----------------------------
procedure Delete_Empty_Directory (Dir_Name : String) is
begin
Delete_Empty_Directory (-Options.Global_Prefix_Dir.V, Dir_Name);
end Delete_Empty_Directory;
-----------------
-- Delete_File --
-----------------
procedure Delete_File (Position : File_Set.Cursor) is
Pathname : constant String := File_Set.Element (Position);
begin
Do_Delete (Pathname);
end Delete_File;
---------------
-- Do_Delete --
---------------
procedure Do_Delete (Filename : String) is
Success : Boolean;
begin
if Options.Dry_Run then
Text_IO.Put_Line ("delete " & Filename);
else
OS_Lib.Delete_File (Filename, Success);
Delete_Empty_Directory (Containing_Directory (Filename));
end if;
end Do_Delete;
Dir : constant String :=
(if OS_Lib.Is_Absolute_Path (Install_Name)
then Containing_Directory (Install_Name)
else Options.Project_Dir & "manifests") & DS;
Name : constant String :=
(if OS_Lib.Is_Absolute_Path (Install_Name)
then Install_Name
else Dir & Install_Name);
Man : Text_IO.File_Type;
Buffer : String (1 .. 4096);
Last : Natural;
Files : File_Set.Set;
Changed : File_Set.Set;
-- Ranges in Buffer above, we have the MD5 (32 chars) a space and then
-- the filename.
subtype MD5_Range is Positive range Message_Digest'Range;
subtype Name_Range is Positive range MD5_Range'Last + 2 .. Buffer'Last;
File_Digest : Message_Digest := (others => ASCII.NUL);
Expected_Digest : Message_Digest;
Removed : Boolean;
Prefix : Path_Name.Object;
begin
-- Check if manifest for this project exists
if not Exists (Name) then
raise GPRinstall_Error with "Manifest " & Name & " not found.";
end if;
if Options.Verbosity > Quiet then
Text_IO.Put_Line ("Uninstall project " & Install_Name);
end if;
-- Check each file to be deleted
Text_IO.Open (Man, Text_IO.In_File, Name);
while not Text_IO.End_Of_File (Man) loop
Text_IO.Get_Line (Man, Buffer, Last);
-- Skip first line if it is the original project's signature
if Last > MD5_Range'Last
and then Buffer (1 .. 2) /= Sig_Line
then
declare
F_Name : constant String := Buffer (Name_Range'First .. Last);
Pathname : constant String := Dir & F_Name;
Path : constant Path_Name.Object :=
Path_Name.Create_File (Filename_Type (Pathname));
begin
Expected_Digest := Buffer (MD5_Range);
if Exists (Pathname) then
File_Digest := Path.Content_MD5;
Removed := False;
else
Removed := True;
end if;
if Options.Global_Prefix_Dir.Default then
if not Prefix.Is_Defined then
Prefix := Path_Name.Create_Directory
(Filename_Type (Path.Dir_Name));
else
Prefix := Prefix.Common_Prefix (Path);
end if;
end if;
-- Unconditionally add a file to the remove list if digest is
-- ok, if we are running in force mode or the file has already
-- been removed.
if File_Digest = Expected_Digest
or else Options.Force_Installations
or else Removed
then
Files.Include (Pathname);
else
Changed.Include (Pathname);
end if;
end;
end if;
end loop;
Text_IO.Close (Man);
if Prefix.Is_Defined then
Options.Global_Prefix_Dir := (-Prefix.Value, False);
end if;
-- Delete files
if Changed.Is_Subset (Of_Set => Files) then
Files.Iterate (Delete_File'Access);
-- Then finally delete the manifest for this project
Do_Delete (Name);
else
if Options.Verbosity > Quiet then
Text_IO.Put_Line ("Following files have been changed:");
declare
procedure Display (Position : File_Set.Cursor);
-- Display only if not part of Files set
-------------
-- Display --
-------------
procedure Display (Position : File_Set.Cursor) is
F_Name : constant String := File_Set.Element (Position);
begin
if not Files.Contains (F_Name) then
Text_IO.Put_Line (F_Name);
end if;
end Display;
begin
Changed.Iterate (Display'Access);
end;
raise GPRinstall_Error
with "use option -f to force file deletion.";
end if;
end if;
end Process;
end GPRinstall.Uninstall;
|