1 unit DebugAttachDialog;
2 
3 {$mode objfpc}{$H+}
4 {$ifdef darwin}
5   {$modeswitch ObjectiveC1}
6 {$endif}
7 
8 interface
9 
10 uses
11   Classes, SysUtils, Forms, Controls, Dialogs, StdCtrls, ComCtrls,
12   LCLType, LazFileUtils, DbgIntfDebuggerBase,
13   LazarusIDEStrConsts, BaseDebugManager, Debugger;
14 
15 type
16   {$IFDEF darwin}
17   TMyDummyObcCClass = objcclass(NSObject)
18     // dummy class to get rid of FPC messages unit objcbase not used
19     b: BOOL;
20   end;
21   {$ENDIF}
22 
23   { TDebugAttachDialogForm }
24 
25   TDebugAttachDialogForm = class(TForm)
26     btnRefresh: TButton;
27     btnAttach: TButton;
28     btnCancel: TButton;
29     labelRunningProcesses: TLabel;
30     lvProcesses: TListView;
31     procedure btnRefreshClick(Sender: TObject);
32     procedure FormCreate(Sender: TObject);
33     procedure lvProcessesColumnClick(Sender: TObject; Column: TListColumn);
34     procedure lvProcessesData(Sender: TObject; Item: TListItem);
35     procedure lvProcessesDblClick(Sender: TObject);
36     procedure lvProcessesKeyDown(Sender: TObject; var Key: Word;
37       {%H-}Shift: TShiftState);
38     procedure lvProcessesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
39   private
40     FPidString: string;
41     FList: TRunningProcessInfoList;
42 
43     // Must return chosen process id as string in PidString and mrOk as result
44     // on success.
ChooseProcessnull45     function ChooseProcess(AList: TRunningProcessInfoList; out PidString: string): TModalResult;
46   public
47     FSortColumn: Integer;
48     FSortBackward: Boolean;
49   end;
50 
51 var
52   DebugAttachDialogForm: TDebugAttachDialogForm;
53 
54 // Ask user for Process ID to attach to and returns it in a string form.
GetPidForAttachnull55 function GetPidForAttach: string;
56 
57 implementation
58 
59 {$ifdef windows}
60 uses
61   Windows
62   {$ifndef WIN9XPLATFORM}
63   ,JwaTlHelp32
64   {$endif};
65 
66 // Enumerate running processes.
67 // Result must be always set: True if enumeration supported or False otherwise.
68 // If AList is not nil it must be filled with TRunningProcessInfo items.
EnumerateProcessesnull69 function EnumerateProcesses(AList: TRunningProcessInfoList): boolean;
70 {$ifndef WIN9XPLATFORM}
71 var
72   hShot: HANDLE;
73   pe: tagPROCESSENTRY32W;
74   item: TRunningProcessInfo;
75 {$endif}
76 begin
77   {$ifdef WIN9XPLATFORM}
78   Result := False;
79   {$else}
80   Result := True; // we can enumerate processes
81   if not Assigned(AList) then
82     Exit;
83 
84   hShot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
85   if hShot = INVALID_HANDLE_VALUE then
86     Exit;
87 
88   try
89     FillByte(pe{%H-}, SizeOf(pe), 0);
90     pe.dwSize := SizeOf(pe);
91     if Process32FirstW(hShot, pe) then
92     repeat
93       item := TRunningProcessInfo.Create(pe.th32ProcessID, pe.szExeFile);
94       AList.Add(item);
95     until not Process32NextW(hShot, pe);
96   finally
97     CloseHandle(hShot);
98   end;
99   {$endif}
100 end;
101 {$else}
102 {$ifdef linux}
103 uses
104   LazUTF8Classes;
105 
EnumerateProcessesnull106 function EnumerateProcesses(AList: TRunningProcessInfoList): boolean;
107 
GetProcNamenull108   function GetProcName(Pid: THandle): String;
109   var
110     S: TStream;
111     Sz: Integer;
112   begin
113     S := TFileStreamUTF8.Create('/proc/' + IntToStr(Pid) + '/cmdline', fmOpenRead or fmShareDenyNone);
114     try
115       SetLength(Result, 255);
116       Sz := S.Read(Result[1], 255);
117       SetLength(Result, Sz);
118     finally
119       S.Free;
120     end;
121   end;
122 
123 var
124   Rec: TSearchRec;
125   ProcName: String;
126   Pid: THandle;
127   Code: Integer;
128   item: TRunningProcessInfo;
129 begin
130   Result := True;
131 
132   if not Assigned(AList) then
133     Exit;
134 
135   if FindFirstUTF8('/proc/*', faDirectory, Rec) = 0 then
136   begin
137     repeat
138       Val(Rec.Name, Pid, Code);
139       if (Code = 0) then
140       begin
141         ProcName := GetProcName(Pid);
142         item := TRunningProcessInfo.Create(Pid, ProcName);
143         AList.Add(item);
144       end;
145     until FindNextUTF8(Rec) <> 0;
146   end;
147   FindCloseUTF8(Rec);
148 end;
149 {$else}
150 {$ifdef darwin}
151 uses
152   MacOSAll, CocoaAll;
153 
CFStringToStrnull154 function CFStringToStr(AString: CFStringRef; Encoding: CFStringEncoding = kCFStringEncodingUTF8): String;
155 var
156   Str: Pointer;
157   StrSize: CFIndex;
158   StrRange: CFRange;
159 begin
160   if AString = nil then
161   begin
162     Result := '';
163     Exit;
164   end;
165 
166   // Try the quick way first
167   Str := CFStringGetCStringPtr(AString, Encoding);
168   if Str <> nil then
169     Result := PChar(Str)
170   else
171   begin
172     // if that doesn't work this will
173     StrRange.location := 0;
174     StrRange.length := CFStringGetLength(AString);
175 
176     StrSize:=0;
177     CFStringGetBytes(AString, StrRange, Encoding,
178       Ord('?'), False, nil, 0, StrSize);
179     SetLength(Result, StrSize);
180 
181     if StrSize > 0 then
182       CFStringGetBytes(AString, StrRange, Encoding,
183         Ord('?'), False, @Result[1], StrSize, StrSize);
184   end;
185 end;
186 
187 function EnumerateProcesses(AList: TRunningProcessInfoList): boolean;
188 var
189   Arr: NSArray;
190   App: NSRunningApplication;
191   I: Integer;
192   item: TRunningProcessInfo;
193 begin
194   Result := True; // we can enumerate processes
195 
196   if not Assigned(AList) then
197     Exit;
198 
199   // If it is not possible to get the process-list from the debugger,
200   // use NSRunningApplication as fallback method. This list is not complete,
201   // though. But better then nothing.
202   Arr := NSWorkspace.sharedWorkspace.runningApplications;
203   for I := 0 to Arr.count - 1 do
204   begin
205     App := NSRunningApplication(Arr.objectAtIndex(I));
206     item := TRunningProcessInfo.Create(App.processIdentifier, CFStringToStr(CFStringRef(App.localizedName)));
207     AList.Add(item);
208   end;
209 end;
210 {$else}
211 function EnumerateProcesses(AList: TRunningProcessInfoList): boolean;
212 begin
213   Result := False;
214 end;
215 {$endif}
216 {$endif}
217 {$endif}
218 
219 function GetPidForAttach: string;
220 var
221   ProcessList: TRunningProcessInfoList;
222 begin
223   Result := '';
224 
225   ProcessList := TRunningProcessInfoList.Create(True);
226   try
227     // Check if we can enumerate processes.
228     if not DebugBoss.FillProcessList(ProcessList) then
229       if not EnumerateProcesses(ProcessList) then
230       begin
231         // If we can't just ask PID as string.
232         InputQuery(rsAttachTo, rsEnterPID, Result);
233         Exit;
234       end;
235 
236     // Enumerate.
237     DebugAttachDialogForm := TDebugAttachDialogForm.Create(nil);
238     try
239       if DebugAttachDialogForm.ChooseProcess(ProcessList, Result) <> mrOK then
240         Result := '';
241     finally
242       FreeAndNil(DebugAttachDialogForm);
243     end;
244 
245   finally
246     FreeAndNil(ProcessList);
247   end;
248 end;
249 
250 {$R *.lfm}
251 
252 { TDebugAttachDialogForm }
253 
254 procedure TDebugAttachDialogForm.lvProcessesData(Sender: TObject;
255   Item: TListItem);
256 var
257   info: TRunningProcessInfo;
258 begin
259   if Item.Index <> -1 then
260   begin
261     info := TRunningProcessInfo(FList.Items[Item.Index]);
262     Item.Caption := info.ImageName;
263     Item.SubItems.Add(IntToStr(info.PID));
264   end;
265 end;
266 
267 procedure TDebugAttachDialogForm.lvProcessesDblClick(Sender: TObject);
268 begin
269   if lvProcesses.ItemIndex <> -1 then
270     ModalResult := mrOK;
271 end;
272 
273 procedure TDebugAttachDialogForm.lvProcessesKeyDown(Sender: TObject;
274   var Key: Word; Shift: TShiftState);
275 begin
276   case Key of
277     VK_RETURN:
278       ModalResult := mrOK;
279     VK_ESCAPE:
280       ModalResult := mrCancel;
281   end;
282 end;
283 
284 procedure TDebugAttachDialogForm.lvProcessesSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
285 var
286   info: TRunningProcessInfo;
287 begin
288   if (Item.Index <> -1) And Selected then
289   begin
290     info := TRunningProcessInfo(FList.Items[Item.Index]);
291     FPidString := IntToStr(info.PID);
292     btnAttach.Enabled := True;
293   end;
294 end;
295 
CompareListItemsnull296 function CompareListItems(Item1, Item2: Pointer): Integer;
297 begin
298   case DebugAttachDialogForm.FSortColumn of
299     0: Result := AnsiStrComp(pchar(TRunningProcessInfo(Item1).ImageName),
300                              pchar(TRunningProcessInfo(Item2).ImageName));
301     1: Result := integer(int64(TRunningProcessInfo(Item1).PID) -
302                          int64(TRunningProcessInfo(Item2).PID));
303     else Result := 0;
304   end;
305   if DebugAttachDialogForm.FSortBackward then
306     Result := -Result;
307 end;
308 
309 procedure TDebugAttachDialogForm.lvProcessesColumnClick(Sender: TObject;
310   Column: TListColumn);
311 begin
312   if FSortColumn = Column.Index then
313     FSortBackward := not FSortBackward
314   else
315     FSortBackward := False;
316   FSortColumn := Column.Index;
317 
318   if FSortColumn >= 0 then
319     FList.Sort(@CompareListItems);
320 
321   lvProcesses.Items.Clear;
322   lvProcesses.Items.Count := FList.Count;
323 end;
324 
325 procedure TDebugAttachDialogForm.btnRefreshClick(Sender: TObject);
326 begin
327   lvProcesses.Items.Clear;
328   FSortColumn := -1;
329   FList.Clear;
330   if not DebugBoss.FillProcessList(FList)
331   then
332     EnumerateProcesses(FList);
333   lvProcesses.Items.Count := FList.Count;
334 end;
335 
336 procedure TDebugAttachDialogForm.FormCreate(Sender: TObject);
337 begin
338   Caption:=rsAttachTo;
339   labelRunningProcesses.Caption:=lisDADRunningProcesses;
340   lvProcesses.Column[0].Caption:=lisDADImageName;
341   lvProcesses.Column[1].Caption:=lisDADPID;
342   btnRefresh.Caption:=dlgUnitDepRefresh;
343   btnAttach.Caption:=lisDADAttach;
344   btnCancel.Caption:=lisCancel;
345 end;
346 
ChooseProcessnull347 function TDebugAttachDialogForm.ChooseProcess(AList: TRunningProcessInfoList;
348   out PidString: string): TModalResult;
349 begin
350   FPidString := '';
351   FList := AList;
352   FSortColumn := -1;
353   lvProcesses.Items.Count := AList.Count;
354   Result := ShowModal;
355   if Result = mrOK then
356     PidString := FPidString;
357 end;
358 
359 end.
360 
361