1 {
2 ***************************************************************************
3 * *
4 * This source is free software; you can redistribute it and/or modify *
5 * it under the terms of the GNU General Public License as published by *
6 * the Free Software Foundation; either version 2 of the License, or *
7 * (at your option) any later version. *
8 * *
9 * This code is distributed in the hope that it will be useful, but *
10 * WITHOUT ANY WARRANTY; without even the implied warranty of *
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
12 * General Public License for more details. *
13 * *
14 * A copy of the GNU General Public License is available on the World *
15 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
16 * obtain it by writing to the Free Software Foundation, *
17 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
18 * *
19 ***************************************************************************
20
21 Author: Mattias Gaertner
22
23 Abstract:
24 Procedures and dialogs to check environment. The IDE uses these procedures
25 at startup to check for example the lazarus directory and warns if it looks
26 suspicious and choose another.
27 }
28 unit InitialSetupProc;
29
30 {$mode objfpc}{$H+}
31
32 interface
33
34 uses
35 // RTL + FCL + LCL
36 Classes, SysUtils, strutils, contnrs,
37 // CodeTools
38 DefineTemplates, CodeToolManager, FileProcs,
39 // LazUtils
40 LazFileCache, LazUTF8, LazFileUtils, FileUtil, LazLoggerBase, Laz2_XMLCfg,
41 // IDE
42 LazarusIDEStrConsts, LazConf, EnvironmentOpts, FppkgHelper;
43
44 type
45 TSDFilenameQuality = (
46 sddqInvalid,
47 sddqWrongMinorVersion,
48 sddqWrongVersion,
49 sddqIncomplete,
50 sddqCompatible,
51 sddqMakeNotWithFpc // Make not in the same directory as compiler
52 );
53
54 TSDFileInfo = class
55 public
56 Filename: string; // macros resolved, trimmed, expanded
57 Caption: string; // filename with macros
58 Note: string;
59 Quality: TSDFilenameQuality;
60 end;
61
62 TSDFileInfoList = class (TObjectList)
63 public
AddNewItemnull64 function AddNewItem(aFilename, aCaption: string): TSDFileInfo;
CaptionExistsnull65 function CaptionExists(aCaption: string): boolean;
BestDirnull66 function BestDir: TSDFileInfo;
67 end;
68
69 TSDFilenameType = (
70 sddtLazarusSrcDir,
71 sddtCompilerFilename,
72 sddtFPCSrcDir,
73 sddtMakeExeFilename,
74 sddtDebuggerFilename,
75 sddtFppkgFpcPrefix
76 );
77
78 TSDFlag = (
79 sdfCompilerFilenameNeedsUpdate,
80 sdfFPCSrcDirNeedsUpdate,
81 sdfMakeExeFilenameNeedsUpdate,
82 sdfDebuggerFilenameNeedsUpdate,
83 sdfFppkgConfigFileNeedsUpdate
84 );
85 TSDFlags = set of TSDFlag;
86
87 // Lazarus Directory
CheckLazarusDirectoryQualitynull88 function CheckLazarusDirectoryQuality(ADirectory: string; out Note: string): TSDFilenameQuality;
SearchLazarusDirectoryCandidatesnull89 function SearchLazarusDirectoryCandidates(StopIfFits: boolean): TSDFileInfoList;
90 procedure SetupLazarusDirectory;
91
92 // FreePascal Compiler
CheckFPCExeQualitynull93 function CheckFPCExeQuality(AFilename: string; out Note: string;
94 TestSrcFilename: string): TSDFilenameQuality;
SearchFPCExeCandidatesnull95 function SearchFPCExeCandidates(StopIfFits: boolean;
96 const TestSrcFilename: string): TSDFileInfoList;
97 procedure SetupFPCExeFilename;
98
99 // Pas2js compiler
CheckPas2jsQualitynull100 function CheckPas2jsQuality(AFilename: string; out Note: string;
101 TestSrcFilename: string): TSDFilenameQuality;
102
103 // FPC Source
CheckFPCSrcDirQualitynull104 function CheckFPCSrcDirQuality(ADirectory: string; out Note: string;
105 const FPCVer: String; aUseFileCache: Boolean = True): TSDFilenameQuality;
SearchFPCSrcDirCandidatesnull106 function SearchFPCSrcDirCandidates(StopIfFits: boolean;
107 const FPCVer: string): TSDFileInfoList;
108
109 // Fppkg
CheckFppkgConfigurationnull110 function CheckFppkgConfiguration(var ConfigFile: string; out Msg: string): TSDFilenameQuality;
CheckFppkgConfigFilenull111 function CheckFppkgConfigFile(const AFilename: string; out Note: string): TSDFilenameQuality;
112
113 // Make
114 // Checks a given file to see if it is a valid make executable
CheckMakeExeQualitynull115 function CheckMakeExeQuality(AFilename: string; out Note: string): TSDFilenameQuality;
116 // Search make candidates and add them to the list, including quality level
SearchMakeExeCandidatesnull117 function SearchMakeExeCandidates(StopIfFits: boolean): TSDFileInfoList;
118
GetValueFromPrimaryConfignull119 function GetValueFromPrimaryConfig(OptionFilename, Path: string): string;
GetValueFromSecondaryConfignull120 function GetValueFromSecondaryConfig(OptionFilename, Path: string): string;
GetValueFromIDEConfignull121 function GetValueFromIDEConfig(OptionFilename, Path: string): string;
122
SafeFormatnull123 function SafeFormat(const Fmt: String; const Args: Array of const): String;
124
125 implementation
126
CheckLazarusDirectoryQualitynull127 function CheckLazarusDirectoryQuality(ADirectory: string;
128 out Note: string): TSDFilenameQuality;
129
SubDirExistsnull130 function SubDirExists(SubDir: string; var q: TSDFilenameQuality): boolean;
131 begin
132 SubDir:=GetForcedPathDelims(SubDir);
133 if DirPathExistsCached(ADirectory+SubDir) then exit(true);
134 Result:=false;
135 Note:=Format(lisDirectoryNotFound2, [SubDir]);
136 q:=sddqIncomplete;
137 end;
138
SubFileExistsnull139 function SubFileExists(SubFile: string; var q: TSDFilenameQuality): boolean;
140 begin
141 SubFile:=GetForcedPathDelims(SubFile);
142 if FileExistsCached(ADirectory+SubFile) then exit(true);
143 Result:=false;
144 Note:=Format(lisFileNotFound3, [SubFile]);
145 q:=sddqIncomplete;
146 end;
147
148 var
149 sl: TStringList;
150 VersionIncFile: String;
151 Version: String;
152 begin
153 Result:=sddqInvalid;
154 ADirectory:=TrimFilename(ADirectory);
155 if not DirPathExistsCached(ADirectory) then
156 begin
157 Note:=lisISDDirectoryNotFound;
158 exit;
159 end;
160 ADirectory:=AppendPathDelim(ADirectory);
161 if not SubDirExists('lcl',Result) then exit;
162 if not SubDirExists('packager/globallinks',Result) then exit;
163 if not SubDirExists('ide',Result) then exit;
164 if not SubDirExists('components',Result) then exit;
165 if not SubFileExists('ide/lazarus.lpi',Result) then exit;
166 VersionIncFile:=GetForcedPathDelims('ide/version.inc');
167 if not SubFileExists(VersionIncFile,Result) then exit;
168 sl:=TStringList.Create;
169 try
170 try
171 sl.LoadFromFile(ADirectory+VersionIncFile);
172 if (sl.Count=0) or (sl[0]='') or (sl[0][1]<>'''') then
173 begin
174 Note:=Format(lisInvalidVersionIn, [VersionIncFile]);
175 exit;
176 end;
177 Version:=copy(sl[0],2,length(sl[0])-2);
178 if Version<>LazarusVersionStr then
179 begin
180 Note:=Format(lisWrongVersionIn, [VersionIncFile, Version]);
181 Result:=sddqWrongVersion;
182 exit;
183 end;
184 Note:=lisOk;
185 Result:=sddqCompatible;
186 except
187 on E: Exception do begin
188 Note:=Format(lisUnableToLoadFile2, [VersionIncFile, E.Message]);
189 exit;
190 end;
191 end;
192 finally
193 sl.Free;
194 end;
195 end;
196
SearchLazarusDirectoryCandidatesnull197 function SearchLazarusDirectoryCandidates(StopIfFits: boolean): TSDFileInfoList;
198
CheckDirnull199 function CheckDir(Dir: string; var List: TSDFileInfoList): boolean;
200 var
201 Item: TSDFileInfo;
202 RealDir: String;
203 begin
204 Result:=false;
205 if Dir='' then Dir:='.';
206 ForcePathDelims(Dir);
207 Dir:=ChompPathDelim(Dir);
208 // check if already checked
209 if Assigned(List) and List.CaptionExists(Dir) then exit;
210 EnvironmentOptions.LazarusDirectory:=Dir;
211 RealDir:=ChompPathDelim(EnvironmentOptions.GetParsedLazarusDirectory);
212 DebugLn(['SearchLazarusDirectoryCandidates Value=',Dir,' File=',RealDir]);
213 // check if exists
214 if not DirPathExistsCached(RealDir) then exit;
215 // add to list and check quality
216 if List=nil then
217 List:=TSDFileInfoList.create(true);
218 Item:=List.AddNewItem(RealDir, Dir);
219 Item.Quality:=CheckLazarusDirectoryQuality(RealDir, Item.Note);
220 Result:=(Item.Quality=sddqCompatible) and StopIfFits;
221 end;
222
CheckViaExenull223 function CheckViaExe(Filename: string; var List: TSDFileInfoList): boolean;
224 begin
225 Result:=false;
226 Filename:=FindDefaultExecutablePath(Filename);
227 if Filename='' then exit;
228 Filename:=GetPhysicalFilenameCached(Filename,true);
229 if Filename='' then exit;
230 Result:=CheckDir(ExtractFilePath(Filename),List);
231 end;
232
233 var
234 Dir: String;
235 ResolvedDir: String;
236 Dirs: TStringList;
237 i: Integer;
238 OldLazarusDir: String;
239 begin
240 Result:=nil;
241
242 OldLazarusDir:=EnvironmentOptions.LazarusDirectory;
243 try
244 // first check the value in the options
245 if CheckDir(EnvironmentOptions.LazarusDirectory,Result) then exit;
246
247 // then check the directory of the executable
248 Dir:=ProgramDirectoryWithBundle;
249 if CheckDir(Dir,Result) then exit;
250 ResolvedDir:=GetPhysicalFilenameCached(Dir,false);
251 if (ResolvedDir<>Dir) and (CheckDir(ResolvedDir,Result)) then exit;
252
253 // check the primary options
254 Dir:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
255 'EnvironmentOptions/LazarusDirectory/Value');
256 if CheckDir(Dir,Result) then exit;
257
258 // check the secondary options
259 Dir:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
260 'EnvironmentOptions/LazarusDirectory/Value');
261 if CheckDir(Dir,Result) then exit;
262
263 // check common directories
264 Dirs:=GetDefaultLazarusSrcDirectories;
265 try
266 for i:=0 to Dirs.Count-1 do
267 if CheckDir(Dirs[i],Result) then exit;
268 finally
269 Dirs.Free;
270 end;
271
272 // check history
273 Dirs:=EnvironmentOptions.LazarusDirHistory;
274 if Dirs<>nil then
275 for i:=0 to Dirs.Count-1 do
276 if CheckDir(Dirs[i],Result) then exit;
277
278 // search lazarus-ide and lazarus in PATH, then follow the links,
279 // which will lead to the lazarus directory
280 if CheckViaExe('lazarus-ide'+GetExecutableExt,Result) then exit;
281 if CheckViaExe('lazarus'+GetExecutableExt,Result) then exit;
282
283 finally
284 EnvironmentOptions.LazarusDirectory:=OldLazarusDir;
285 end;
286 end;
287
288 procedure SetupLazarusDirectory;
289 var
290 Dir, Note: String;
291 Quality: TSDFilenameQuality;
292 List: TSDFileInfoList;
293 begin
294 Dir:=EnvironmentOptions.GetParsedLazarusDirectory;
295 Quality:=CheckLazarusDirectoryQuality(Dir,Note);
296 if Quality<>sddqInvalid then exit;
297 // bad lazarus directory => searching a good one
298 dbgout('SetupLazarusDirectory:');
299 if EnvironmentOptions.LazarusDirectory<>'' then
300 begin
301 dbgout(' The Lazarus directory "',EnvironmentOptions.LazarusDirectory,'"');
302 if EnvironmentOptions.LazarusDirectory<>Dir then
303 dbgout(' => "',Dir,'"');
304 dbgout(' is invalid (Error: ',Note,')');
305 debugln(' Searching a proper one ...');
306 end else begin
307 debugln(' Searching ...');
308 end;
309 List:=SearchLazarusDirectoryCandidates(true);
310 try
311 if (List=nil) or (List.BestDir.Quality=sddqInvalid) then begin
312 debugln(['SetupLazarusDirectory: no proper Lazarus directory found.']);
313 exit;
314 end;
315 EnvironmentOptions.LazarusDirectory:=List.BestDir.Filename;
316 debugln(['SetupLazarusDirectory: using ',EnvironmentOptions.LazarusDirectory]);
317 finally
318 List.Free;
319 end;
320 end;
321
CheckFPCExeQualitynull322 function CheckFPCExeQuality(AFilename: string; out Note: string;
323 TestSrcFilename: string): TSDFilenameQuality;
324 var
325 CfgCache: TPCTargetConfigCache;
326
CheckPPUnull327 function CheckPPU(const AnUnitName: string): boolean;
328 begin
329 if (CfgCache.Units=nil)
330 or not FilenameExtIs(CfgCache.Units[AnUnitName],'ppu',true) then
331 begin
332 Note:=Format(lisPpuNotFoundCheckYourFpcCfg, [AnUnitName]);
333 Result:=false;
334 end else
335 Result:=true;
336 end;
337
338 var
339 i: LongInt;
340 ShortFilename: String;
341 begin
342 Result:=sddqInvalid;
343 AFilename:=TrimFilename(AFilename);
344 if not FileExistsCached(AFilename) then
345 begin
346 Note:=lisFileNotFound4;
347 exit;
348 end;
349 if DirPathExistsCached(AFilename) then
350 begin
351 Note:=lisFileIsDirectory;
352 exit;
353 end;
354 if not FileIsExecutableCached(AFilename) then
355 begin
356 Note:=lisFileIsNotAnExecutable;
357 exit;
358 end;
359
360 // do not execute unusual exe files
361 ShortFilename:=ExtractFileNameOnly(AFilename);
362 if (CompareFilenames(ShortFilename,'fpc')<>0)
363 and (CompareFilenames(LeftStr(ShortFilename,3),'ppc')<>0)
364 then begin
365 Note:=lisUnusualCompilerFileNameUsuallyItStartsWithFpcPpcOr;
366 exit(sddqIncomplete);
367 end;
368
369 if TestSrcFilename<>'' then
370 begin
371 CfgCache:=CodeToolBoss.CompilerDefinesCache.ConfigCaches.Find(
372 AFilename,'','','',true);
373 if CfgCache.NeedsUpdate then
374 CfgCache.Update(TestSrcFilename);
375 i:=CfgCache.IndexOfUsedCfgFile;
376 if i<0 then
377 begin
378 Note:=SafeFormat(lisCompilerCfgIsMissing,['fpc.cfg']);
379 exit;
380 end;
381 if not CfgCache.HasPPUs then
382 begin
383 Note:=lisSystemPpuNotFoundCheckYourFpcCfg;
384 exit;
385 end;
386 if (CfgCache.RealTargetCPU='jvm') then
387 begin
388 if not CheckPPU('uuchar') then exit;
389 end else begin
390 if not CheckPPU('classes') then exit;
391 end;
392 end;
393
394 Note:=lisOk;
395 Result:=sddqCompatible;
396 end;
397
SearchFPCExeCandidatesnull398 function SearchFPCExeCandidates(StopIfFits: boolean;
399 const TestSrcFilename: string): TSDFileInfoList;
400 var
401 ShortCompFile: String;
402
CheckFilenull403 function CheckFile(AFilename: string; var List: TSDFileInfoList): boolean;
404 var
405 Item: TSDFileInfo;
406 RealFilename: String;
407 begin
408 Result:=false;
409 if AFilename='' then exit;
410 ForcePathDelims(AFilename);
411 // check if already checked
412 if Assigned(List) and List.CaptionExists(AFilename) then exit;
413 EnvironmentOptions.CompilerFilename:=AFilename;
414 RealFilename:=EnvironmentOptions.GetParsedCompilerFilename;
415 debugln(['SearchCompilerCandidates Value=',AFilename,' File=',RealFilename]);
416 if RealFilename='' then exit;
417 // check if exists
418 if not FileExistsCached(RealFilename) then exit;
419 // add to list and check quality
420 if List=nil then
421 List:=TSDFileInfoList.create(true);
422 Item:=List.AddNewItem(RealFilename, AFilename);
423 Item.Quality:=CheckFPCExeQuality(RealFilename, Item.Note, TestSrcFilename);
424 Result:=(Item.Quality=sddqCompatible) and StopIfFits;
425 end;
426
CheckSubDirsnull427 function CheckSubDirs(ADir: string; var List: TSDFileInfoList): boolean;
428 // search for ADir\bin\i386-win32\fpc.exe
429 // and for ADir\*\bin\i386-win32\fpc.exe
430 var
431 FileInfo: TSearchRec;
432 SubFile: String;
433 begin
434 Result:=true;
435 ADir:=AppendPathDelim(TrimFilename(ExpandFileNameUTF8(TrimFilename(ADir))));
436 SubFile:='bin/$(TargetCPU)-$(TargetOS)/'+ShortCompFile;
437 if CheckFile(ADir+SubFile,List) then
438 exit;
439 try
440 if FindFirstUTF8(ADir+AllFilesMask,faAnyFile,FileInfo)=0 then begin
441 repeat
442 // check if special file
443 if (FileInfo.Name='.') or (FileInfo.Name='..') or (FileInfo.Name='') then
444 continue;
445 if ((FileInfo.Attr and faDirectory)>0)
446 and CheckFile(ADir+FileInfo.Name+PathDelim+SubFile,List) then
447 exit;
448 until FindNextUTF8(FileInfo)<>0;
449 end;
450 finally
451 FindCloseUTF8(FileInfo);
452 end;
453 Result:=false;
454 end;
455
456 var
457 AFilename: String;
458 Files: TStringList;
459 i: Integer;
460 SysDrive: String;
461 ProgDir: String;
462 OldCompilerFilename: String;
463 begin
464 Result:=nil;
465
466 OldCompilerFilename:=EnvironmentOptions.CompilerFilename;
467 try
468 // check current setting
469 if CheckFile(EnvironmentOptions.CompilerFilename,Result) then exit;
470
471 // check the primary options
472 AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
473 'EnvironmentOptions/CompilerFilename/Value');
474 if CheckFile(AFilename,Result) then exit;
475
476 // check the secondary options
477 AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
478 'EnvironmentOptions/CompilerFilename/Value');
479 if CheckFile(AFilename,Result) then exit;
480
481 // check environment variable PP
482 AFileName := GetEnvironmentVariableUTF8('PP');
483 if CheckFile(AFilename,Result) then exit;
484
485 // search fpc(.exe) in PATH
486 if CheckFile('fpc'+ExeExt,Result) then exit;
487
488 // search ppccpu(.exe) in PATH
489 if CheckFile(GetDefaultCompilerFilename(GetCompiledTargetCPU),Result) then exit;
490
491 // check history
492 Files:=EnvironmentOptions.CompilerFileHistory;
493 if Files<>nil then
494 for i:=0 to Files.Count-1 do
495 if CheckFile(Files[i],Result) then exit;
496
497 // check paths with versions
498 ShortCompFile:='fpc'+ExeExt;
499
500 // check $(LazarusDir)\fpc\3.0.0\bin\i386-win32\fpc.exe
501 if CheckFile(GetForcedPathDelims('$(LazarusDir)/fpc/'+{$I %FPCVERSION%}+'/bin/'+GetCompiledTargetCPU+'-'+GetCompiledTargetOS+'/')+ShortCompFile,Result)
502 then exit;
503
504 // check $(LazarusDir)\fpc\bin\i386-win32\fpc.exe
505 if CheckFile(GetForcedPathDelims('$(LazarusDir)/fpc/bin/'+GetCompiledTargetCPU+'-'+GetCompiledTargetOS+'/')+ShortCompFile,Result)
506 then exit;
507
508 // check common directories
509 Files:=TStringList.Create;
510 try
511 GetDefaultCompilerFilenames(Files);
512 for i:=0 to Files.Count-1 do
513 if CheckFile(Files[i],Result) then exit;
514 finally
515 Files.Free;
516 end;
517
518 // Windows-only locations:
519 if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin
520 SysDrive:=GetEnvironmentVariableUTF8('SYSTEMDRIVE');
521 if SysDrive='' then SysDrive:='C:';
522 SysDrive:=AppendPathDelim(SysDrive);
523 // %SYSTEMDRIVE%\fpc\
524 if CheckSubDirs(SysDrive+'FPC',Result) then exit;
525 // %SYSTEMDRIVE%\pp\
526 if CheckSubDirs(SysDrive+'pp',Result) then exit;
527 // %PROGRAMFILES%\FPC\*
528 ProgDir:=AppendPathDelim(GetEnvironmentVariableUTF8('PROGRAMFILES'));
529 if (ProgDir<>'')
530 and CheckSubDirs(ProgDir+'FPC',Result) then exit;
531 end;
532
533 finally
534 EnvironmentOptions.CompilerFilename:=OldCompilerFilename;
535 end;
536 end;
537
538 procedure SetupFPCExeFilename;
539 var
540 Filename, Note: String;
541 Quality: TSDFilenameQuality;
542 List: TSDFileInfoList;
543 begin
544 Filename:=EnvironmentOptions.GetParsedCompilerFilename;
545 Quality:=CheckFPCExeQuality(Filename,Note,'');
546 if Quality<>sddqInvalid then exit;
547 // bad compiler
548 dbgout('SetupCompilerFilename:');
549 if EnvironmentOptions.CompilerFilename<>'' then
550 begin
551 dbgout(' The compiler path "',EnvironmentOptions.CompilerFilename,'"');
552 if EnvironmentOptions.CompilerFilename<>Filename then
553 dbgout(' => "',Filename,'"');
554 dbgout(' is invalid (Error: ',Note,')');
555 debugln(' Searching a proper one ...');
556 end else begin
557 debugln(' Searching compiler ...');
558 end;
559 List:=SearchFPCExeCandidates(true, CodeToolBoss.CompilerDefinesCache.TestFilename);
560 try
561 if (List=nil) or (List.BestDir.Quality=sddqInvalid) then begin
562 debugln(['SetupCompilerFilename: no proper compiler found.']);
563 exit;
564 end;
565 EnvironmentOptions.CompilerFilename:=List.BestDir.Filename;
566 debugln(['SetupCompilerFilename: using ',EnvironmentOptions.CompilerFilename]);
567 finally
568 List.Free;
569 end;
570 end;
571
ValueOfKeynull572 function ValueOfKey(const aLine, aKey: string; var aValue: string): boolean;
573 // If aKey is found in aLine, separate a quoted number following "aKey =",
574 // save it to aValue and return True. Return False if aKey is not found.
575 // Example line: version_nr = '2';
576 var
577 i,j: Integer;
578 begin
579 Result:=False;
580 i:=Pos(aKey, aLine);
581 if i>0 then begin // aKey found
582 i:=PosEx('=', aLine, i+Length(aKey));
583 if i>0 then begin // '=' found
584 i:=PosEx('''', aLine, i+1);
585 if i>0 then begin // Opening quote found
586 j:=PosEx('''', aLine, i+1);
587 if j>0 then begin // Closing quote found
588 aValue:=Copy(aLine, i+1, j-i-1);
589 Result:=True;
590 end;
591 end;
592 end;
593 end;
594 end;
595
CheckPas2jsQualitynull596 function CheckPas2jsQuality(AFilename: string; out Note: string;
597 TestSrcFilename: string): TSDFilenameQuality;
598 var
599 i: LongInt;
600 ShortFilename: String;
601 CfgCache: TPCTargetConfigCache;
602 begin
603 Result:=sddqInvalid;
604 AFilename:=TrimFilename(AFilename);
605 if not FileExistsCached(AFilename) then
606 begin
607 Note:=lisFileNotFound4;
608 exit;
609 end;
610 if DirPathExistsCached(AFilename) then
611 begin
612 Note:=lisFileIsDirectory;
613 exit;
614 end;
615 if not FileIsExecutableCached(AFilename) then
616 begin
617 Note:=lisFileIsNotAnExecutable;
618 exit;
619 end;
620
621 // do not execute unusual exe files
622 ShortFilename:=ExtractFileNameOnly(AFilename);
623 if (CompareText(LeftStr(ShortFilename,6),'pas2js')<>0)
624 then begin
625 Note:=lisUnusualPas2jsCompilerFileNameUsuallyItStartsWithPa;
626 exit(sddqIncomplete);
627 end;
628
629 if TestSrcFilename<>'' then
630 begin
631 CfgCache:=CodeToolBoss.CompilerDefinesCache.ConfigCaches.Find(
632 AFilename,'','','',true);
633 if CfgCache.NeedsUpdate then
634 CfgCache.Update(TestSrcFilename);
635 i:=CfgCache.IndexOfUsedCfgFile;
636 if i<0 then
637 begin
638 Note:=SafeFormat(lisCompilerCfgIsMissing,['pas2js.cfg']);
639 exit;
640 end;
641 //if not CheckPas('classes') then exit;
642 end;
643
644 Note:=lisOk;
645 Result:=sddqCompatible;
646 end;
647
CheckFPCSrcDirQualitynull648 function CheckFPCSrcDirQuality(ADirectory: string; out Note: string;
649 const FPCVer: String; aUseFileCache: Boolean = True): TSDFilenameQuality;
isnull650 // aUseFileCache = False when this function is called from a thread.
651 // File Cache is not thread safe.
652
653 function DirPathExistsInternal(const FileName: String): Boolean;
654 begin
655 if aUseFileCache then
656 Result:=DirPathExistsCached(FileName)
657 else
658 Result:=DirPathExists(FileName)
659 end;
660
FileExistsInternalnull661 function FileExistsInternal(const Filename: string): boolean;
662 begin
663 if aUseFileCache then
664 Result:=FileExistsCached(FileName)
665 else
666 Result:=FileExistsUTF8(FileName)
667 end;
668
SubDirExistsnull669 function SubDirExists(SubDir: string): boolean;
670 begin
671 SubDir:=GetForcedPathDelims(SubDir);
672 if DirPathExistsInternal(ADirectory+SubDir) then exit(true);
673 Result:=false;
674 Note:=Format(lisDirectoryNotFound2, [SubDir]);
675 end;
676
SubFileExistsnull677 function SubFileExists(SubFile: string): boolean;
678 begin
679 SubFile:=GetForcedPathDelims(SubFile);
680 if FileExistsInternal(ADirectory+SubFile) then exit(true);
681 Result:=false;
682 Note:=Format(lisFileNotFound3, [SubFile]);
683 end;
684
685 var
686 VersionFile: String;
687 sl: TStringList;
688 i: Integer;
689 VersionNr: String;
690 ReleaseNr: String;
691 PatchNr: String;
692 SrcVer: String;
693 Line: String;
694 begin
695 Result:=sddqInvalid;
696 Note:='';
697 ADirectory:=TrimFilename(ADirectory);
698 if not DirPathExistsInternal(ADirectory) then
699 begin
700 Note:=lisISDDirectoryNotFound;
701 exit;
702 end;
703 ADirectory:=AppendPathDelim(ADirectory);
704 if not SubDirExists('rtl') then exit;
705 if not SubDirExists('packages') then exit;
706 Result:=sddqIncomplete;
707 if not SubFileExists('rtl/linux/system.pp') then exit;
708 // check version
709 if (FPCVer<>'') then
710 begin
711 VersionFile:=ADirectory+'compiler'+PathDelim+'version.pas';
712 if FileExistsInternal(VersionFile) then
713 begin
714 sl:=TStringList.Create;
715 try
716 try
717 sl.LoadFromFile(VersionFile);
718 VersionNr:='';
719 ReleaseNr:='';
720 PatchNr:='';
721 for i:=0 to sl.Count-1 do
722 begin
723 Line:=sl[i];
724 if ValueOfKey(Line,'version_nr', VersionNr) then begin end
725 else if ValueOfKey(Line,'release_nr', ReleaseNr) then begin end
726 else if ValueOfKey(Line,'patch_nr', PatchNr) then
727 break;
728 end;
729 SrcVer:=VersionNr+'.'+ReleaseNr+'.'+PatchNr;
730 if SrcVer<>FPCVer then
731 begin
732 Note:=Format(lisFoundVersionExpected, [SrcVer, FPCVer]);
733 SrcVer:=VersionNr+'.'+ReleaseNr+'.';
734 if LeftStr(FPCVer,length(SrcVer))=SrcVer then
735 Result:=sddqWrongMinorVersion
736 else
737 Result:=sddqWrongVersion;
738 exit;
739 end;
740 except
741 end;
742 finally
743 sl.Free;
744 end;
745 end;
746 end;
747 Note:=lisOk;
748 Result:=sddqCompatible;
749 end;
750
SearchFPCSrcDirCandidatesnull751 function SearchFPCSrcDirCandidates(StopIfFits: boolean; const FPCVer: string): TSDFileInfoList;
752
Checknull753 function Check(Dir: string; var List: TSDFileInfoList): boolean;
754 var
755 Item: TSDFileInfo;
756 RealDir: String;
757 begin
758 Result:=false;
759 Dir:=ChompPathDelim(GetForcedPathDelims(Dir));
760 if Dir='' then exit;
761 // check if already checked
762 if Assigned(List) and List.CaptionExists(Dir) then exit;
763 EnvironmentOptions.FPCSourceDirectory:=Dir;
764 RealDir:=EnvironmentOptions.GetParsedFPCSourceDirectory;
765 debugln(['SearchFPCSrcDirCandidates Value=',Dir,' File=',RealDir]);
766 if RealDir='' then exit;
767 // check if exists
768 if not DirPathExistsCached(RealDir) then exit;
769 // add to list and check quality
770 if List=nil then
771 List:=TSDFileInfoList.Create(true);
772 Item:=List.AddNewItem(RealDir, Dir);
773 Item.Quality:=CheckFPCSrcDirQuality(RealDir, Item.Note, FPCVer);
774 Result:=(Item.Quality=sddqCompatible) and StopIfFits;
775 end;
776
777 var
778 AFilename: String;
779 Dirs: TStringList;
780 i: Integer;
781 OldFPCSrcDir: String;
782 begin
783 Result:=nil;
784
785 OldFPCSrcDir:=EnvironmentOptions.FPCSourceDirectory;
786 try
787 // check current setting
788 if Check(EnvironmentOptions.FPCSourceDirectory,Result) then exit;
789
790 // check the primary options
791 AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
792 'EnvironmentOptions/FPCSourceDirectory/Value');
793 if Check(AFilename,Result) then exit;
794
795 // check the secondary options
796 AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
797 'EnvironmentOptions/FPCSourceDirectory/Value');
798 if Check(AFilename,Result) then exit;
799
800 // check environment variable FPCDIR
801 AFileName := GetEnvironmentVariableUTF8('FPCDIR');
802 if Check(AFilename,Result) then exit;
803
804 // check relative to FPCDIR
805 if AFileName <> '' then
806 if Check(AFilename + '/../fpcsrc', Result) then exit;
807
808 // check history
809 Dirs:=EnvironmentOptions.FPCSourceDirHistory;
810 if Dirs<>nil then
811 for i:=0 to Dirs.Count-1 do
812 if Check(Dirs[i],Result) then exit;
813
814 // $(LazarusDir)/fpc/$(FPCVer)/source
815 AFilename:='$(LazarusDir)/fpc/$(FPCVer)/source';
816 if Check(AFilename,Result) then exit;
817
818 // check relative to fpc.exe
819 AFilename:='$Path($(CompPath))/../../source';
820 if Check(AFilename,Result) then exit;
821
822 // check common directories
823 Dirs:=GetDefaultFPCSrcDirectories;
824 try
825 if Dirs<>nil then
826 for i:=0 to Dirs.Count-1 do
827 if Check(Dirs[i],Result) then exit;
828 finally
829 Dirs.Free;
830 end;
831 finally
832 EnvironmentOptions.FPCSourceDirectory:=OldFPCSrcDir;
833 end;
834 end;
835
CheckFppkgConfigurationnull836 function CheckFppkgConfiguration(var ConfigFile: string; out Msg: string): TSDFilenameQuality;
837 var
838 Fppkg: TFppkgHelper;
839 begin
840 Fppkg := TFppkgHelper.Instance;
841 Fppkg.OverrideConfigurationFilename := ConfigFile;
842
843 if Fppkg.IsProperlyConfigured(Msg) then
844 Result := sddqCompatible
845 else
846 Result := sddqInvalid;
847 ConfigFile := Fppkg.GetConfigurationFileName;
848 end;
849
CheckFppkgConfigFilenull850 function CheckFppkgConfigFile(const AFilename: string; out Note: string): TSDFilenameQuality;
851 begin
852 Note := '';
853 if AFilename='' then
854 begin
855 Result := sddqCompatible;
856 end
857 else
858 begin
859 if not FileExistsCached(AFilename) then
860 begin
861 Result := sddqIncomplete;
862 Note:=lisFileNotFound;
863 end
864 else
865 begin
866 if DirectoryExists(AFilename) then
867 begin
868 Result := sddqInvalid;
869 Note:=lisFileIsDirectory;
870 end
871 else
872 Result := sddqCompatible;
873 end;
874 end;
875 end;
876
CheckMakeExeQualitynull877 function CheckMakeExeQuality(AFilename: string; out Note: string
878 ): TSDFilenameQuality;
879 begin
880 Result:=sddqInvalid;
881 AFilename:=TrimFilename(AFilename);
882 if not FileExistsCached(AFilename) then
883 begin
884 Note:=lisFileNotFound4;
885 exit;
886 end;
887 if DirPathExistsCached(AFilename) then
888 begin
889 Note:=lisFileIsDirectory;
890 exit;
891 end;
892 if not FileIsExecutableCached(AFilename) then
893 begin
894 Note:=lisFileIsNotAnExecutable;
895 exit;
896 end;
897
898 // Windows-only locations:
899 if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin
900 // under Windows, make.exe is in the same directory as fpc.exe
901 // other make.exe are often incompatible
902 if not FileExistsCached(ExtractFilePath(AFilename)+'fpc.exe') then begin
903 Note:=Format(lisThereIsNoFpcExeInTheDirectoryOfUsuallyTheMakeExecu, [
904 ExtractFilename(AFilename)]);
905 Result:=sddqMakeNotWithFpc;
906 exit;
907 end;
908 end;
909
910 Note:=lisOk;
911 Result:=sddqCompatible;
912 end;
913
SearchMakeExeCandidatesnull914 function SearchMakeExeCandidates(StopIfFits: boolean): TSDFileInfoList;
915
CheckFilenull916 function CheckFile(AFilename: string; var List: TSDFileInfoList): boolean;
917 var
918 Item: TSDFileInfo;
919 RealFilename: String;
920 begin
921 Result:=false;
922 if AFilename='' then exit;
923 ForcePathDelims(AFilename);
924 // check if already checked
925 if Assigned(List) and List.CaptionExists(AFilename) then exit;
926 EnvironmentOptions.MakeFilename:=AFilename;
927 RealFilename:=EnvironmentOptions.GetParsedMakeFilename;
928 debugln(['SearchMakeExeCandidates Value=',AFilename,' File=',RealFilename]);
929 if RealFilename='' then exit;
930 // check if exists
931 if not FileExistsCached(RealFilename) then exit;
932 // add to list and check quality
933 if List=nil then
934 List:=TSDFileInfoList.create(true);
935 Item:=List.AddNewItem(RealFilename, AFilename);
936 Item.Quality:=CheckMakeExeQuality(RealFilename, Item.Note);
937 Result:=(Item.Quality=sddqCompatible) or ((Item.Quality=sddqMakeNotWithFpc) and StopIfFits);
938 end;
939
940 var
941 OldMakeFilename: String;
942 AFilename: String;
943 Files: TStringList;
944 i: Integer;
945 begin
946 Result:=nil;
947
948 OldMakeFilename:=EnvironmentOptions.MakeFilename;
949 try
950 // check current setting
951 if CheckFile(EnvironmentOptions.MakeFilename,Result) then exit;
952
953 // check the primary options
954 AFilename:=GetValueFromPrimaryConfig(EnvOptsConfFileName,
955 'EnvironmentOptions/MakeFilename/Value');
956 if CheckFile(AFilename,Result) then exit;
957
958 // check the secondary options
959 AFilename:=GetValueFromSecondaryConfig(EnvOptsConfFileName,
960 'EnvironmentOptions/MakeFilename/Value');
961 if CheckFile(AFilename,Result) then exit;
962
963 // Windows-only locations:
964 if (GetDefaultSrcOSForTargetOS(GetCompiledTargetOS)='win') then begin
965 // check make in fpc.exe directory
966 if CheckFile(GetForcedPathDelims('$Path($(CompPath))\make.exe'),Result)
967 then exit;
968 // check $(LazarusDir)\fpc\bin\i386-win32\fpc.exe
969 if CheckFile(GetForcedPathDelims('$(LazarusDir)\fpc\bin\$(TargetCPU)-$(TargetOS)\make.exe'),Result)
970 then exit;
971 end;
972
973 // check history
974 Files:=EnvironmentOptions.MakeFileHistory;
975 if Files<>nil then
976 for i:=0 to Files.Count-1 do
977 if CheckFile(Files[i],Result) then exit;
978
979 // check PATH
980 {$IFDEF FreeBSD}
981 AFilename:='gmake';
982 {$ELSE}
983 AFilename:='make';
984 {$ENDIF}
985 {$IFDEF dragonfly}
986 AFilename:='gmake';
987 {$ENDIF}
988 AFilename+=GetExecutableExt;
989 if CheckFile(FindDefaultExecutablePath(AFilename),Result) then exit;
990
991 // check common directories
992 Files:=TStringList.Create;
993 try
994 GetDefaultMakeFilenames(Files);
995 for i:=0 to Files.Count-1 do
996 if CheckFile(Files[i],Result) then exit;
997 finally
998 Files.Free;
999 end;
1000 finally
1001 EnvironmentOptions.MakeFilename:=OldMakeFilename;
1002 end;
1003 end;
1004
GetValueFromPrimaryConfignull1005 function GetValueFromPrimaryConfig(OptionFilename, Path: string): string;
1006 begin
1007 if not FilenameIsAbsolute(OptionFilename) then
1008 OptionFilename:=AppendPathDelim(GetPrimaryConfigPath)+OptionFilename;
1009 Result:=GetValueFromIDEConfig(OptionFilename,Path);
1010 end;
1011
GetValueFromSecondaryConfignull1012 function GetValueFromSecondaryConfig(OptionFilename, Path: string): string;
1013 begin
1014 if not FilenameIsAbsolute(OptionFilename) then
1015 OptionFilename:=AppendPathDelim(GetSecondaryConfigPath)+OptionFilename;
1016 Result:=GetValueFromIDEConfig(OptionFilename,Path);
1017 end;
1018
GetValueFromIDEConfignull1019 function GetValueFromIDEConfig(OptionFilename, Path: string): string;
1020 var
1021 XMLConfig: TXMLConfig;
1022 begin
1023 Result:='';
1024 if FileExistsCached(OptionFilename) then
1025 begin
1026 try
1027 XMLConfig:=TXMLConfig.Create(OptionFilename);
1028 try
1029 Result:=XMLConfig.GetValue(Path,'');
1030 finally
1031 XMLConfig.Free;
1032 end;
1033 except
1034 on E: Exception do begin
1035 debugln(['GetValueFromIDEConfig File='+OptionFilename+': '+E.Message]);
1036 end;
1037 end;
1038 end;
1039 end;
1040
SafeFormatnull1041 function SafeFormat(const Fmt: String; const Args: array of const): String;
1042 begin
1043 // try with translated resourcestring
1044 try
1045 Result:=Format(Fmt,Args);
1046 exit;
1047 except
1048 on E: Exception do
1049 debugln(['ERROR: SafeFormat: ',E.Message]);
1050 end;
1051 // translation didn't work
1052 // ToDo: find out how to get the resourcestring default value
1053 //ResetResourceTables;
1054
1055 // use a safe fallback
1056 Result:=SimpleFormat(Fmt,Args);
1057 end;
1058
1059 { TSDFileInfoList }
1060
AddNewItemnull1061 function TSDFileInfoList.AddNewItem(aFilename, aCaption: string): TSDFileInfo;
1062 begin
1063 Result:=TSDFileInfo.Create;
1064 Result.Filename:=aFilename;
1065 Result.Caption:=aCaption;
1066 Add(Result);
1067 end;
1068
CaptionExistsnull1069 function TSDFileInfoList.CaptionExists(aCaption: string): boolean;
1070 var
1071 i: Integer;
1072 begin
1073 Result:=false;
1074 for i:=0 to Count-1 do
1075 if CompareFilenames(aCaption,TSDFileInfo(Items[i]).Caption)=0 then
1076 exit(true);
1077 end;
1078
BestDirnull1079 function TSDFileInfoList.BestDir: TSDFileInfo;
1080 begin
1081 if Count > 0 then
1082 Result:=TSDFileInfo(Items[Count-1])
1083 else
1084 Result:=Nil;
1085 end;
1086
1087 end.
1088
1089