1 {
2 /***************************************************************************
3 idecmdline.pas
4 --------------------
5 A unit to manage command lines issue used inside the ide
6
7 ***************************************************************************/
8
9 ***************************************************************************
10 * *
11 * This source is free software; you can redistribute it and/or modify *
12 * it under the terms of the GNU General Public License as published by *
13 * the Free Software Foundation; either version 2 of the License, or *
14 * (at your option) any later version. *
15 * *
16 * This code is distributed in the hope that it will be useful, but *
17 * WITHOUT ANY WARRANTY; without even the implied warranty of *
18 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *
19 * General Public License for more details. *
20 * *
21 * A copy of the GNU General Public License is available on the World *
22 * Wide Web at <http://www.gnu.org/copyleft/gpl.html>. You can also *
23 * obtain it by writing to the Free Software Foundation, *
24 * Inc., 51 Franklin Street - Fifth Floor, Boston, MA 02110-1335, USA. *
25 * *
26 ***************************************************************************
27
28 Author: Mattias Gaertner
29
30 This unit manages the command line parameters for lazarus and startlazarus,
31 but not lazbuild.
32
33 ToDo:
34 Linux: try pidof
35 }
36 unit IDEGuiCmdLine;
37
38 {$mode objfpc}{$H+}
39
40 interface
41
42 uses
43 Classes, SysUtils, Math,
44 // LazUtils
45 LazUtilities, LazFileUtils, LazStringUtils,
46 // Codetools
47 FileProcs,
48 // IDE
49 LazConf, IDECmdLine;
50
51 procedure ParseGuiCmdLineParams(var SkipAutoLoadingLastProject,
52 StartedByStartLazarus,
53 EnableRemoteControl,
54 ShowSplashScreen,
55 Setup: Boolean);
56
57 // remote control
58 const
59 EnableRemoteControlOpt='--remote-control';
60 var
61 EnableRemoteControl: boolean = false;
62
SetupMainIDEInstancenull63 function SetupMainIDEInstance: boolean; // false if this is a secondary instance
GetPidFilenull64 function GetPidFile: string;
IsLazarusPIDRunningnull65 function IsLazarusPIDRunning({%H-}aPID: int64): boolean;
GetRemoteControlFilenamenull66 function GetRemoteControlFilename: string;
67 procedure CleanUpPIDFile;
68
69 implementation
70
71 {$IFDEF Linux}
72 {$DEFINE UseProcFileSystem}
73 {$ENDIF}
74 {$IF defined(FreeBSD) and defined(VER2_5)}
75 {$DEFINE UseFreeBSDKernProc}
76 uses FreeBSD, BaseUnix;
77 {$ENDIF}
78 {$IFDEF LCLCarbon}
79 {$DEFINE UseCarbonProc}
80 uses MacOSAll, CarbonProc;
81 {$ENDIF}
82
IsLazarusPIDRunningnull83 function IsLazarusPIDRunning(aPID: int64): boolean;
84
85 {$IFDEF UseProcFileSystem}
CheckProcFileSystemnull86 function CheckProcFileSystem: boolean;
87 var
88 sl: TStringList;
89 Filename: String;
90 begin
91 Result:=false;
92 Filename:='/proc/'+IntToStr(aPID)+'/cmdline';
93 if not FileExists(Filename) then exit;
94 sl:=TStringList.Create;
95 try
96 try
97 sl.LoadFromFile(Filename);
98 if sl.Count=0 then exit;
99 if PosI('lazarus',sl[0])<1 then exit;
100 Result:=true;
101 except
102 end;
103 finally
104 sl.Free;
105 end;
106 end;
107 {$ENDIF}
108
109 {$IFDEF UseFreeBSDKernProc}
CheckFreeBSDKernProcnull110 function CheckFreeBSDKernProc: boolean;
111 var
112 s: string;
113 begin
114 Result:=(kernproc_getpath(aPID,s)<>-1)
115 and (PosI('lazarus',s)>0);
116 end;
117 {$ENDIF}
118
119 {$IFDEF UseCarbonProc}
CheckCarbonProcnull120 function CheckCarbonProc: boolean;
121 var
122 psn: ProcessSerialNumber;
123 info: ProcessInfoRec;
124 processName: CFStringRef;
125 s: String;
126 begin
127 Result:=false;
128 if GetProcessForPID(aPid,psn{%H-})<>noErr then exit;
129 FillByte(info{%H-},SizeOf(info),0);
130 if GetProcessInformation(psn,info)<>noErr then exit;
131 processName := nil;
132 if CopyProcessName(psn, processName)<>noErr then exit;
133 if processName<>nil then begin
134 s:=CFStringToStr(processName);
135 CFRelease(processName);
136 Result:=PosI('lazarus',s)>0;
137 end;
138 end;
139 {$ENDIF}
140
141 begin
142 Result:=true;
143 {$IFDEF UseFreeBSDKernProc}
144 if CheckFreeBSDKernProc then exit;
145 {$ENDIF}
146 {$IFDEF UseProcFileSystem}
147 if CheckProcFileSystem then exit;
148 {$ENDIF}
149 {$IFDEF UseCarbonProc}
150 if CheckCarbonProc then exit;
151 {$ENDIF}
152 Result:=false;
153 end;
154
GetPidFilenull155 function GetPidFile: string;
156 begin
157 Result:=AppendPathDelim(GetPrimaryConfigPath)+'pid.txt';
158 end;
159
160 procedure ParseGuiCmdLineParams(var SkipAutoLoadingLastProject,
161 StartedByStartLazarus, EnableRemoteControl, ShowSplashScreen, Setup: Boolean);
162 var
163 i: Integer;
164 begin
165 ParseNoGuiCmdLineParams;
166 for i:= 1 to ParamsAndCfgCount do
167 begin
168 //DebugLn(['ParseGuiCmdLineParams ',i,' "',ParamsAndCfgStr(i),'"']);
169 if ParamIsOption(i, NoSplashScreenOptLong) or
170 ParamIsOption(i, NoSplashScreenOptShort) then
171 ShowSplashScreen := false
172 else if ParamIsOption(i, ShowSetupDialogOptLong) then
173 Setup:=true
174 else if ParamIsOption(i, SkipLastProjectOpt) then
175 SkipAutoLoadingLastProject := true
176 else if ParamIsOption(i, StartedByStartLazarusOpt) then
177 StartedByStartLazarus := true
178 else if ParamIsOption(i, EnableRemoteControlOpt) then
179 EnableRemoteControl := true
180 else if ParamIsOption(i, '--verbose') then
181 ConsoleVerbosity:=Max(1,ConsoleVerbosity+1)
182 else if ParamIsOption(i, '--quiet') then
183 ConsoleVerbosity:=Min(0,ConsoleVerbosity-1);
184 end;
185 if ConsoleVerbosity>=0 then
186 CTConsoleVerbosity:=1;
187 end;
188
SetupMainIDEInstancenull189 function SetupMainIDEInstance: boolean;
190
191 procedure WritePIDFile(const Filename: string; aPID: int64);
192 var
193 Dir: String;
194 sl: TStringList;
195 begin
196 debugln(['WritePIDFile File="',Filename,'" PID=',aPID]);
197 sl:=TStringList.Create;
198 try
199 sl.Add(IntToStr(aPID));
200 try
201 Dir:=ChompPathDelim(ExtractFilePath(Filename));
202 if not DirectoryExistsUTF8(Dir) then begin
203 if not CreateDirUTF8(Dir) then
204 debugln(['WritePIDFile failed to create directory ',Dir]);
205 exit;
206 end;
207 sl.SaveToFile(Filename);
208 except
209 on E: Exception do begin
210 debugln(['WritePIDFile "',Filename,'" failed:']);
211 debugln(E.Message);
212 end;
213 end;
214 finally
215 sl.Free;
216 end;
217 end;
218
ReadPIDFilenull219 function ReadPIDFile(const Filename: string; out ConfigPID: int64): boolean;
220 var
221 sl: TStringList;
222 begin
223 Result:=false;
224 ConfigPID:=-1;
225 debugln(['ReadPIDFile ',Filename]);
226 if not FileExistsUTF8(Filename) then exit;
227 sl:=TStringList.Create;
228 try
229 try
230 sl.LoadFromFile(Filename);
231 ConfigPID:=StrToInt64(sl[0]);
232 Result:=true;
233 debugln(['ReadPIDFile ConfigPID=',ConfigPID]);
234 except
235 on E: Exception do begin
236 debugln(['ReadPIDFile "',Filename,'" failed:']);
237 debugln(E.Message);
238 end;
239 end;
240 finally
241 sl.Free;
242 end;
243 end;
244
245 procedure SendCmdlineActionsToMainInstance;
246 var
247 sl: TStringList;
248 Param: String;
249 Filename: String;
250 i: Integer;
251 begin
252 sl:=TStringList.Create;
253 try
254 sl.Add('Show');
255 for i:=1 to ParamsAndCfgCount do begin
256 Param:=ParamsAndCfgStr(i);
257 if (Param='') or (Param[1]='-') then continue;
258 sl.Add('Open '+Param);
259 end;
260 Filename:=GetRemoteControlFilename;
261 try
262 debugln(['SendCmdlineActionsToMainInstance Commands="',sl.Text,'"']);
263 sl.SaveToFile(Filename);
264 except
265 on E: Exception do begin
266 debugln(['SendCmdlineActionsToMainInstance failed to write ',Filename]);
267 debugln(E.Message);
268 end;
269 end;
270 finally
271 sl.Free;
272 end;
273 end;
274
275 var
276 PIDFilename: String;
277 MyPID, ConfigPID: int64;
278 PIDRead: Boolean;
279 begin
280 Result:=true;
281 if not EnableRemoteControl then exit;
282
283 // check if another IDE (of this user and same configuration) is already
284 // running. Request it to handle the show and handle the command line
285 // parameters (e.g. open files). And if successful return false.
286 // Otherwise become the main instance.
287 PIDFilename:=GetPidFile;
288 MyPID:=GetProcessID;
289 ConfigPID:=-1;
290 PIDRead:=ReadPIDFile(PIDFilename,ConfigPID);
291 if PIDRead and (ConfigPID<>MyPID) then begin
292 // there is a pid file from another instance
293 if not IsLazarusPIDRunning(ConfigPID) then begin
294 // clean up
295 DeleteFileUTF8(PIDFilename);
296 PIDRead:=false;
297 end;
298 end;
299 if not FileExistsUTF8(PIDFilename) then begin
300 // try to become the main instance
301 WritePIDFile(PIDFilename,MyPID);
302 PIDRead:=false;
303 end;
304 if not PIDRead then
305 PIDRead:=ReadPIDFile(PIDFilename,ConfigPID);
306 if ConfigPID=MyPID then begin
307 // this is the main instance
308 exit;
309 end;
310 // this is a second instance
311 Result:=false;
312
313 SendCmdlineActionsToMainInstance;
314 end;
315
GetRemoteControlFilenamenull316 function GetRemoteControlFilename: string;
317 begin
318 Result:=AppendPathDelim(GetPrimaryConfigPath)+'ideremotecontrol.txt';
319 end;
320
321 procedure CleanUpPIDFile;
322 begin
323 if EnableRemoteControl then
324 DeleteFileUTF8(GetRemoteControlFilename);
325 end;
326
327 end.
328
329