diff options
Diffstat (limited to 'UCore.pas')
| -rw-r--r-- | UCore.pas | 244 |
1 files changed, 173 insertions, 71 deletions
@@ -20,11 +20,10 @@ unit UCore; interface -uses glib2, SyncObjs, Classes, GTKForms, GTKView, ULibc, UEngines, UCoreUtils, UProgress, UVFSCore; +uses glib2, SyncObjs, Classes, GTKForms, GTKView, ULibc, UEngines, UCoreUtils, UProgress, UVFSCore, uVFSprototypes; function FillPanel(List: TList; ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean): boolean; -function ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): integer; function MakeDirectory(ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean; NewDir: string): boolean; procedure FindNextSelected(ListView: TGTKListView; DataList: TList; var Item1, Item2: string); procedure UnselectAll(ListView: TGTKListView; DataList: TList); @@ -120,6 +119,9 @@ type TWorkerThread = class(TThread) end; TOpenDirThread = class(TThread) + private + FThreadID: __pthread_t; + function ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): integer; protected procedure Execute; override; public @@ -135,8 +137,27 @@ type TWorkerThread = class(TThread) APlugin: TVFSPlugin; AFullPath, AHighlightItem: string; Password: string; + + VFSCallbackEvent: TSimpleEvent; + VFSAskQuestion_Message: PChar; + VFSAskQuestion_Choices: PPChar; + VFSAskQuestion_Choice: PInteger; + VFSAskQuestion_Display: boolean; + + VFSAskPassword_Message: PChar; + VFSAskPassword_default_user: PChar; + VFSAskPassword_default_domain: PChar; + VFSAskPassword_flags: TVFSAskPasswordFlags; + VFSAskPassword_username: PPChar; + VFSAskPassword_password: PPChar; + VFSAskPassword_anonymous: PInteger; + VFSAskPassword_domain: PPChar; + VFSAskPassword_password_save: PVFSPasswordSave; + VFSAskPassword_Display: boolean; + VFSAskPassword_Result: LongBool; + constructor Create; -{ destructor Destroy; override; } + destructor Destroy; override; end; @@ -190,6 +211,11 @@ procedure CleanTempDirs; procedure DebugWriteListSL(List: TList); procedure DebugWriteList(List: TList); +{$IFDEF KYLIX} +const INFINITE = Cardinal(-1); +{$ENDIF} + + var LeftLocalEngine, RightLocalEngine: TPanelEngine; LeftPanelData, RightPanelData, AssocList, MounterList, ConnectionMgrList: TList; CommandLineHistory, Bookmarks: TStringList; @@ -204,8 +230,7 @@ var LeftLocalEngine, RightLocalEngine: TPanelEngine; implementation (********************************************************************************************************************************) uses SysUtils, DateUtils, StrUtils, UConfig, UDirDelete, UOverwrite, ULocale, - UNewDir, UFileAssoc, USymlink, UCoreClasses, ULogin, uVFSprototypes, - URemoteWait, UMain; + UNewDir, UFileAssoc, USymlink, UCoreClasses, ULogin, URemoteWait, UMain, UGnome; @@ -393,58 +418,6 @@ begin end; (********************************************************************************************************************************) -function ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): integer; - - procedure GoUp(var NewPath: string); - var x: integer; - begin - if NewPath = PathDelim then Exit; - NewPath := ExcludeTrailingPathDelimiter(NewPath); - if Length(Trim(NewPath)) < 2 then Exit; - x := PosEnd(PathDelim, NewPath); - SelItem := Copy(NewPath, x + 1, Length(NewPath) - x); - NewPath := Copy(NewPath, 1, x); - NewPath := IncludeTrailingPathDelimiter(NewPath); - end; - -var APath: string; - Error : integer; -begin - try - APath := Engine.Path; - if Path = '..' then GoUp(APath) - else begin - APath := IncludeTrailingPathDelimiter(APath); - Path := IncludeTrailingPathDelimiter(Path); - if (Length(Path) > 0) and (Path[1] <> '/') - then APath := APath + Path - else APath := Path; - APath := IncludeTrailingPathDelimiter(APath); - end; - - // AutoFallback loop - Error := Engine.ChangeDir(APath); - while AutoFallback and (Error <> 0) and (APath <> '/') do begin - GoUp(APath); - Error := Engine.ChangeDir(APath); - end; - // Going on... - if Error <> 0 then begin - Result := Error; - DebugMsg(['*** UCore.ChangeDir: error during Engine.ChangeDir: ', GetErrorString(Error)]); - Exit; - end; - Engine.Path := APath; - Result := 0; - except - on E: Exception do begin - DebugMsg(['*** Exception raised in UCore.ChangeDir (', E.ClassName, '): ', E.Message]); - Result := 1; - end; - end; -end; - -(********************************************************************************************************************************) function MakeDirectory(ListView: TGTKListView; Engine: TPanelEngine; LeftPanel: boolean; NewDir: string): boolean; var Error: integer; begin @@ -518,7 +491,7 @@ begin if IsDir and (not IsLnk) then Engine.FillDirFiles(CurrPath + String(FName), AList, 1) else AList.Add(Engine.GetFileInfoSL(CurrPath + String(FName))); - if Engine.ChangeDir(CurrPath, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + if Engine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); Engine.ExplicitChDir('/'); SetProgress1Params(AList.Count); @@ -566,7 +539,7 @@ begin for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; - if Engine.ChangeDir(CurrPath, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + if Engine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); end; SenderThread.FDoneThread := True; end; @@ -1072,8 +1045,8 @@ begin end; end; -{ if DestEngine.ChangeDir(CurrPath, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); - if SrcEngine.ChangeDir(CurrPath, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); } +{ if DestEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); + if SrcEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour may occur.']); } // DebugWriteListSL(List); __chdir('/'); @@ -1139,9 +1112,9 @@ begin for i := List.Count - 1 downto 0 do FreeDataItem(PDataItemSL(List[i])); List.Clear; List.Free; - if DestEngine.ChangeDir(SaveDestPath, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + if DestEngine.ChangeDir(SaveDestPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); if SaveSrcPath <> '' then CurrPath := SaveSrcPath; - if SrcEngine.ChangeDir(CurrPath, False) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); + if SrcEngine.ChangeDir(CurrPath) <> 0 then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); end; SenderThread.FDoneThread := True; DebugMsg(['(II) CopyFilesWorker: finished']); @@ -2639,11 +2612,29 @@ begin APlugin := nil; xEngine := nil; Password := ''; + VFSCallbackEvent := TSimpleEvent.Create; + VFSAskQuestion_Display := False; + VFSAskPassword_Display := False; +end; + +destructor TOpenDirThread.Destroy; +begin +{ + if (APlugin <> nil) and (xEngine <> nil) then + try + xEngine.Free; + except + on E: Exception do DebugMsg(['*** TOpenDirThread.Destroy -Exception: ', E.Message]); + end; +} + VFSCallbackEvent.Free; + inherited Destroy; end; procedure TOpenDirThread.Execute; var tt: TDateTime; begin + FThreadID := pthread_self; try // Writeln('execute.'); tt := Now; @@ -2686,16 +2677,127 @@ begin end; } end; -{ destructor TOpenDirThread.Destroy; +(********************************************************************************************************************************) +procedure vfs_ask_question_callback(const AMessage: PChar; const Choices: PPChar; choice: PInteger; user_data: Pointer); cdecl; +var Thread: TOpenDirThread; begin - if (APlugin <> nil) and (xEngine <> nil) then - try - xEngine.Free; - except - on E: Exception do DebugMsg(['*** TOpenDirThread.Destroy -Exception: ', E.Message]); + if pthread_self = Application.ThreadID then begin + DebugMsg(['!! (WARNING): vfs_ask_question_callback called from the main thread, expected spawn from a OpenDirThread']); + HandleVFSAskQuestionCallback(nil, AMessage, Choices, choice); + Exit; + end; + + Thread := user_data; + if (Thread <> nil) and (Thread is TOpenDirThread) and (pthread_self = Thread.FThreadID) then begin + DebugMsg(['******* vfs_ask_question_callback spawned, user_data = 0x', IntToHex(QWord(user_data), 16), ', ThreadID = 0x', IntToHex(pthread_self, 16)]); + Thread.VFSAskQuestion_Message := AMessage; + Thread.VFSAskQuestion_Choices := Choices; + Thread.VFSAskQuestion_Choice := choice; + Thread.VFSAskQuestion_Display := True; + Thread.VFSCallbackEvent.WaitFor(INFINITE); + DebugMsg(['******* thread: resuming...']); + Exit; + end; + + DebugMsg(['!! (ERROR): vfs_ask_question_callback spawned neither from the main thread nor from active OpenDirThread, dropping the callback to prevent data corruption.']); + if (Thread <> nil) and (Thread is TOpenDirThread) + then DebugMsg([' ThreadID = 0x', IntToHex(pthread_self, 16), ', OpenDirThread ID = 0x', IntToHex(Thread.FThreadID, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); +end; + +function vfs_ask_password_callback(const AMessage: PChar; const default_user: PChar; const default_domain: PChar; flags: TVFSAskPasswordFlags; + username, password: PPChar; anonymous: PInteger; domain: PPChar; password_save: PVFSPasswordSave; + user_data: Pointer): LongBool; cdecl; +var Thread: TOpenDirThread; +begin + if pthread_self = Application.ThreadID then begin + DebugMsg(['!! (WARNING): vfs_ask_password_callback called from the main thread, expected spawn from a OpenDirThread']); + Result := HandleVFSAskPasswordCallback(nil, AMessage, default_user, default_domain, flags, username, password, anonymous, domain, password_save); + Exit; + end; + + Thread := user_data; + if (Thread <> nil) and (Thread is TOpenDirThread) and (pthread_self = Thread.FThreadID) then begin + DebugMsg(['******* vfs_ask_password_callback spawned, user_data = 0x', IntToHex(QWord(user_data), 16), ', ThreadID = 0x', IntToHex(pthread_self, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); + Thread.VFSAskPassword_Message := AMessage; + Thread.VFSAskPassword_default_user := default_user; + Thread.VFSAskPassword_default_domain := default_domain; + Thread.VFSAskPassword_flags := flags; + Thread.VFSAskPassword_username := username; + Thread.VFSAskPassword_password := password; + Thread.VFSAskPassword_anonymous := anonymous; + Thread.VFSAskPassword_domain := domain; + Thread.VFSAskPassword_password_save := password_save; + Thread.VFSAskPassword_Display := True; + Thread.VFSAskPassword_Result := False; + Thread.VFSCallbackEvent.WaitFor(INFINITE); + DebugMsg(['******* thread: resuming...']); + Result := Thread.VFSAskPassword_Result; + Exit; + end; + + DebugMsg(['!! (ERROR): vfs_ask_password_callback spawned neither from the main thread nor from active OpenDirThread, dropping the callback to prevent data corruption.']); + if (Thread <> nil) and (Thread is TOpenDirThread) + then DebugMsg([' ThreadID = 0x', IntToHex(pthread_self, 16), ', OpenDirThread ID = 0x', IntToHex(Thread.FThreadID, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); + Result := False; +end; + + +function TOpenDirThread.ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): integer; + + procedure GoUp(var NewPath: string); + var x: integer; + begin + if NewPath = PathDelim then Exit; + NewPath := ExcludeTrailingPathDelimiter(NewPath); + if Length(Trim(NewPath)) < 2 then Exit; + x := PosEnd(PathDelim, NewPath); + SelItem := Copy(NewPath, x + 1, Length(NewPath) - x); + NewPath := Copy(NewPath, 1, x); + NewPath := IncludeTrailingPathDelimiter(NewPath); + end; + +var APath: string; + Error : integer; +begin + try + APath := Engine.Path; + if Path = '..' then GoUp(APath) + else begin + APath := IncludeTrailingPathDelimiter(APath); + Path := IncludeTrailingPathDelimiter(Path); + if (Length(Path) > 0) and (Path[1] <> '/') + then APath := APath + Path + else APath := Path; + APath := IncludeTrailingPathDelimiter(APath); end; - inherited Destroy; -end; } + + // AutoFallback loop + if Engine is TVFSEngine + then Error := (Engine as TVFSEngine).ChangeDirEx(APath, @vfs_ask_question_callback, @vfs_ask_password_callback, Self) + else Error := Engine.ChangeDir(APath); + + while AutoFallback and (Error <> 0) and (APath <> '/') do begin + GoUp(APath); + if Engine is TVFSEngine + then Error := (Engine as TVFSEngine).ChangeDirEx(APath, @vfs_ask_question_callback, @vfs_ask_password_callback, Self) + else Error := Engine.ChangeDir(APath); + end; + // Going on... + if Error <> 0 then begin + Result := Error; + DebugMsg(['*** UCore.ChangeDir: error during Engine.ChangeDir: ', GetErrorString(Error)]); + Exit; + end; + Engine.Path := APath; + Result := 0; + except + on E: Exception do begin + DebugMsg(['*** Exception raised in UCore.ChangeDir (', E.ClassName, '): ', E.Message]); + Result := 1; + end; + end; +end; + (********************************************************************************************************************************) (********************************************************************************************************************************) |