Repository navigation
Expand file tree
/
Copy pathGenerateSmartLoad.pas
More file actions
333 lines (292 loc) · 10.1 KB
/
Copy pathGenerateSmartLoad.pas
File metadata and controls
333 lines (292 loc) · 10.1 KB
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
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
{
This file is part of the MWA Software Pascal API Code Generator for OpenSSL .
Copyright © MWA Software 2024
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 <https://www.gnu.org/licenses/>.
}
unit GenerateSmartLoad;
{$IFDEF FPC}
{$mode Delphi}
{$ENDIF}
(*
This unit defines the class TGenerateSmartLoadUnit as a subclass of the abstract
class TGenerateAPIUnit. TGenerateSmartLoadUnit adds Load and Unload procedures
to the output API unit in respect of dynamic library loading and initialises each
API function variable to nil.
At load time, each API function is loaded in turn. If it fails to load then the
API function variable is set to the address of a compatibility function, if one exists
or to an error function that raises a customised exception.
The exception is when the API function is marked up as "Allow nil" when a failure to
load results in the corresponding API function variable remaining nil. It is the
responsiblity of the caller to check for nil values and handle them appropriately.
The Unload procedure simply resets each API function variable back to nil.
*)
interface
uses
Classes , SysUtils, GenerateHeaderUnit, APIFileReader, ProgramConstants;
type
{ TGenerateSmartLoadUnit }
TGenerateSmartLoadUnit = class(TGenerateAPIUnit)
private
FHasLoadFunction: boolean;
FHasUnLoadFunction: boolean;
protected
procedure AddErrorFunctions(S : TStrings); override;
procedure AddDynamicLoadInit(S: TStrings); override;
procedure AddLoadFunctions(S : TStrings); override;
procedure AddUnLoadFunctions(S : TStrings); override;
procedure Clear; override;
function GetInitialiser(funcProc: IFuncProcInfo): string; override;
function GetImplementationUses: string; override;
procedure AddNoLegacyConditionals(S : TStrings; funcProc: IFuncProcInfo; var InLegacy: boolean);
function PreLoadFunction(funcProc: IFuncProcInfo): boolean; virtual;
end;
implementation
uses Tokeniser;
{ TGenerateSmartLoadUnit }
procedure TGenerateSmartLoadUnit.AddErrorFunctions(S : TStrings);
var i: integer;
funcProc: IFuncProcInfo;
ErrorImplementation: TStrings;
begin
ErrorImplementation := TStringList.Create;
try
with InterfaceSection do
begin
for i := 0 to Count - 1 do
begin
if TObject(Items[i]) is IFuncProcInfo then
funcProc := TObject(Items[i]) as IFuncProcInfo
else
begin
if TObject(Items[i]) is TDirective then
with TObject(Items[i]) as TDirective do
begin
ErrorImplementation.Add('{$' + Name + Condition + '}')
end;
continue;
end;
if PreLoadFunction(funcProc) then
with funcProc do
if not AllowNil then
begin
with ErrorImplementation do
begin
if (CompatibilityFunctions.IndexOf(ProcName) <> -1) then
Add('{$IFDEF ' + NoLegacySupportSymbol + '}');
Add(GetDeclaration('ERROR_'));
Add('begin');
Add(' ' + ErrorExceptionClassName + '.RaiseException(''' + procName + ''');');
Add('end;');
if (CompatibilityFunctions.IndexOf(ProcName) <> -1) then
Add('{$ENDIF} { End of ' + NoLegacySupportSymbol + '}');
Add('');
end;
end;
end;
if ErrorImplementation.Count > 0 then
begin
S.Add('');
S.Add('{$WARN NO_RETVAL OFF}');
S.AddStrings(ErrorImplementation);
S.Add('{$WARN NO_RETVAL ON}');
end;
end;
finally
ErrorImplementation.Free;
end;
end;
procedure TGenerateSmartLoadUnit.AddDynamicLoadInit(S : TStrings);
begin
S.Add('{$IFNDEF ' + StaticLinkModel + '}');
if FHasLoadFunction then
S.Add('Register_SSLLoader(@Load);');
if FHasUnLoadFunction then
S.Add('Register_SSLUnloader(@Unload);');
S.Add('{$ENDIF}');
end;
procedure TGenerateSmartLoadUnit.AddLoadFunctions(S : TStrings);
var i: integer;
funcProc: IFuncProcInfo;
LoadFunction: TStrings;
Inlegacy: boolean;
InConditional: boolean;
begin
InConditional := false;
Inlegacy := false;
LoadFunction := TStringList.Create;
try
LoadFunction.Add('procedure Load(LibVersion: TOpenSSL_C_UINT; const AFailed: TStringList);');
LoadFunction.Add('var FuncLoadError: boolean;');
LoadFunction.Add('begin');
with InterfaceSection do
for i := 0 to Count - 1 do
begin
if TObject(Items[i]) is IFuncProcInfo then
funcProc := TObject(Items[i]) as IFuncProcInfo
else
begin
if TObject(Items[i]) is TDirective then
begin
with TObject(Items[i]) as TDirective do
LoadFunction.Add('{$' + Name + Condition + '}');
InConditional := true;
end;
continue;
end;
if PreLoadFunction(funcProc) then
with funcProc do
begin
FHasLoadFunction := true;
AddNoLegacyConditionals(LoadFunction,funcProc,InLegacy);
LoadFunction.Add(' ' + procName + ' := Load' + LibName + 'Function(''' + procName + ''');');
LoadFunction.Add(' FuncLoadError := not assigned(' + procName + ');');
LoadFunction.Add(' if FuncLoadError then');
LoadFunction.Add(' begin');
if CompatibilityFunctions.IndexOf(procName) <> -1 then
begin
if not InLegacy then
LoadFunction.Add('{$IFNDEF ' + NoLegacySupportSymbol + '}');
LoadFunction.Add(' ' + procName + ' := @COMPAT_' + procName + ';');
if not InLegacy then
LoadFunction.Add('{$ELSE}');
end;
if not AllowNil then
begin
if not InLegacy then
LoadFunction.Add(' ' + procName + ' := @ERROR_' + procName + ';');
if Introduced then
begin
LoadFunction.Add(' if LibVersion < ' + procName + '_introduced then');
LoadFunction.Add(' FuncLoadError := false;');
end;
if Removed then
begin
LoadFunction.Add(' if ' + procName + '_removed <= LibVersion then');
LoadFunction.Add(' FuncLoadError := false;');
end;
if Introduced or Removed then
begin
LoadFunction.Add(' if FuncLoadError then');
LoadFunction.Add(' AFailed.Add(''' + procName + ''');');
end;
end
else
LoadFunction.Add(' {Don''t report allow nil failure}');
// LoadFunction.Add(' AFailed.Add(''' + procName + ''');');
if (CompatibilityFunctions.IndexOf(procName) <> -1) and not InLegacy then
LoadFunction.Add('{$ENDIF}');
LoadFunction.Add(' end;');
if InConditional then
begin
AddNoLegacyConditionals(LoadFunction,nil,InLegacy);
InConditional := false;
end;
LoadFunction.Add('');
end;
end;
AddNoLegacyConditionals(LoadFunction,nil,InLegacy);
LoadFunction.Add('end;');
if FHasLoadFunction then
S.AddStrings(LoadFunction);
finally
LoadFunction.Free;
end;
end;
procedure TGenerateSmartLoadUnit.AddUnLoadFunctions(S : TStrings);
var i: integer;
UnLoadFunction: TStrings;
funcProc: IFuncProcInfo;
InLegacy: boolean;
InConditional: boolean;
begin
InLegacy := false;
InConditional := false;
UnLoadFunction := TStringList.Create;
try
UnLoadFunction.Add('');
UnLoadFunction.Add('procedure UnLoad;');
UnLoadFunction.Add('begin');
with InterfaceSection do
for i := 0 to Count - 1 do
begin
if TObject(Items[i]) is TDirective then
with TObject(Items[i]) as TDirective do
begin
UnLoadFunction.Add('{$' + Name + Condition + '}');
InConditional := true;
end
else
if TObject(Items[i]) is IFuncProcInfo then
begin
funcProc := TObject(Items[i]) as IFuncProcInfo;
FHasUnLoadFunction := true;
AddNoLegacyConditionals(UnLoadFunction,funcProc,InLegacy);
with funcProc do
if IsFunction then
UnLoadFunction.Add(' ' + ProcName + ' := ' + GetInitialiser(funcProc) + ';')
else
UnLoadFunction.Add(' ' + ProcName + ' := ' + GetInitialiser(funcProc) + ';');
if InLegacy and InConditional then
AddNoLegacyConditionals(UnLoadFunction,nil,InLegacy);
InConditional := false;
end
end;
AddNoLegacyConditionals(UnLoadFunction,nil,InLegacy);
UnLoadFunction.Add('end;');
if FHasUnLoadFunction then
S.AddStrings(UnLoadFunction);
finally
UnLoadFunction.Free
end;
end;
procedure TGenerateSmartLoadUnit.Clear;
begin
inherited Clear;
FHasUnLoadFunction := false;
FHasLoadFunction := false;
end;
function TGenerateSmartLoadUnit.GetInitialiser(funcProc : IFuncProcInfo
) : string;
begin
Result := 'nil';
end;
function TGenerateSmartLoadUnit.GetImplementationUses : string;
var i: integer;
Separator: string;
begin
Result := '';
Separator := '';
for i := 0 to length(ImplementationSectionUses) - 1 do
begin
Result := Result + Separator + DoFixUp(ImplementationSectionUses[i]);
Separator := ',' + LineEnding + ' ';
end;
end;
procedure TGenerateSmartLoadUnit.AddNoLegacyConditionals(S : TStrings;
funcProc : IFuncProcInfo; var InLegacy : boolean);
begin
if assigned(funcProc) and funcProc.Removed and not InLegacy then
begin
S.Add('{$IFNDEF ' + NoLegacySupportSymbol + '}');
InLegacy := true;
end;
if (not assigned(funcProc) or not funcProc.Removed) and InLegacy then
begin
S.Add('{$ENDIF} //of ' + NoLegacySupportSymbol);
InLegacy := false;
end;
end;
function TGenerateSmartLoadUnit.PreLoadFunction(funcProc : IFuncProcInfo
) : boolean;
begin
Result := true;
end;
end.