(* Tux Commander - UCoreWorkers - worker threads, operations Copyright (C) 2009 Tomas Bzatek Check for updates on tuxcmd.sourceforge.net 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 2 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, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) unit UCoreWorkers; interface uses glib2, gtk2, SyncObjs, Classes, GTKForms, GTKView, ULibc, UEngines, UCoreUtils, UVFSCore, uVFSprototypes, UCore, UDirDelete; type TWorkerThreadJobType = (WORKER_JOB_DUMMY, WORKER_JOB_DELETE, WORKER_JOB_COPY, WORKER_JOB_MOVE, WORKER_JOB_EXTRACT_TO_TEMP, WORKER_JOB_MERGE, WORKER_JOB_SPLIT, WORKER_JOB_CHMOD, WORKER_JOB_CHOWN); type TVFSCallbackThread = class(TThread) private FThreadID: __pthread_t; FFinished: boolean; 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_default_password: PChar; VFSAskPassword_flags: TVFSAskPasswordFlags; VFSAskPassword_username: PPChar; VFSAskPassword_password: PPChar; VFSAskPassword_anonymous: Pgboolean; VFSAskPassword_domain: PPChar; VFSAskPassword_password_save: PVFSPasswordSave; VFSAskPassword_Display: boolean; VFSAskPassword_Result: boolean; procedure PrepareExecute; // Call this right after thread has been started public FCancelled: boolean; AEngine: TPanelEngine; APlugin: TVFSPlugin; // VFS callback dialogs have been cancelled VFSCallbackCancelled: boolean; // Connection manager VFSConnectionManagerMode: boolean; VFSQuickConnectMode: boolean; // Set this to properly handle modal dialogs DialogsParentWindow: TCustomGTKForm; constructor Create(CreateSuspended: boolean); destructor Destroy; override; end; TWorkerThread = class(TVFSCallbackThread) private FGUIMutex: TCriticalSection; FCallbackLockEvent: TSimpleEvent; // Copy worker progress values FTotalSize, FTotalDone, FFileSize: cuLongLong; FCopySkipAllErrors: boolean; FCopyProgressFunc: TEngineProgressFunc; // Dialogs FCancelMessage: string; FShowCancelMessage, FDialogShowDirDelete, FDialogShowOverwrite, FDialogShowNewDir, FDialogShowMsgBox: boolean; FDialogResultDirDelete, FDialogResultOverwrite, FDialogResultNewDir: integer; FProgress1Pos, FProgress2Pos, FProgress1Max, FProgress2Max: Int64; FProgress1Text, FProgress2Text, FLabel1Text, FLabel2Text: string; FGUIProgress1Pos, FGUIProgress2Pos, FGUIProgress1Max, FGUIProgress2Max: Int64; FGUIProgress1Text, FGUIProgress2Text, FGUILabel1Text, FGUILabel2Text: string; FGUIChanged: boolean; FDirDeleteButtonsType: TFDirDeleteButtonSet; FDirDeleteTitle, FDirDeleteFileName: string; FDirDeleteError: PGError; FOverwriteShowAppend: boolean; FOverwriteSourceItem, FOverwriteDestItem: PDataItem; FOverwriteSourceFile, FOverwriteDestFile, FOverwriteRenameStr: string; FNewDirCaption, FNewDirLabel, FNewDirEdit: string; FMsgBoxText: string; FMsgBoxButtons: TMessageButtons; FMsgBoxStyle: TMessageStyle; FMsgBoxDefault, FMsgBoxEscape, FDialogResultMsgBox: TMessageButton; procedure UpdateProgress1(const Progress: Int64; const ProgressText: string); procedure UpdateProgress2(const Progress: Int64; const ProgressText: string); procedure SetProgress1Params(const ProgressMax: Int64); procedure SetProgress2Params(const ProgressMax: Int64); procedure UpdateCaption1(const CaptionText: string); procedure UpdateCaption2(const CaptionText: string); function ShowDirDeleteDialog(ButtonsType: TFDirDeleteButtonSet; const Title, FileName: string; Error: PGError): integer; function ShowOverwriteDialog(ShowAppend: boolean; SourceItem, DestItem: PDataItem; const SourceFile, DestFile: string; var RenameStr: string): integer; function ShowNewDirDialog(Caption, LabelCaption, Edit: string): integer; function ShowMessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle; Default, Escape: TMessageButton): TMessageButton; procedure DeleteFilesWorker; procedure CopyFilesWorker; procedure MergeFilesWorker; procedure SplitFilesWorker; procedure ChmodFilesWorker; procedure ChownFilesWorker; procedure DummyThreadWorker; protected procedure Execute; override; procedure CommitGUIUpdate; public JobType: TWorkerThreadJobType; SrcEngine, DestEngine: TPanelEngine; ErrorHappened: boolean; // For getting list of selected items in the panel DataList: TList; SelectedItem: PDataItem; CopyTargetPath: string; QuickRenameDataItem: PDataItem; ExtractFromVFSAll: boolean; ExtractFile: string; // full path to the file to extract (to a temp directory) ChmodMode: cuLong; ChmodRecurseType: integer; ChownUID, ChownGID: cuLong; ChownRecursive: boolean; MergeTargetCRC: Cardinal; MergeHasInitialCRC: boolean; MergeTargetFinalName: string; MergeTargetSize: Int64; MergeSourceFile: string; MergeTargetPath: string; SplitDeleteTarget: boolean; SplitMaxSize: Int64; SplitSourceFile: string; SplitTargetPath: string; constructor Create; destructor Destroy; override; procedure PrepareJobFilesFromPanel(AList: TList; DoNotRecurse: boolean); end; TOpenDirThread = class(TVFSCallbackThread) private function ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): boolean; protected procedure Execute; override; public APath: string; ASelItem: string; AAutoFallBack: boolean; ADirList: TList; RunningTime: Int64; AFullPath, AHighlightItem: string; ChDirResult, ListingResult, VFSOpenResult: boolean; ChDirError, ListingError, VFSOpenError: PGError; constructor Create; destructor Destroy; override; end; TOpenConnectionThread = class(TVFSCallbackThread) private protected procedure Execute; override; public URI: string; OpenResult: boolean; OpenError: PGError; constructor Create; destructor Destroy; override; end; // Worker threads utilities // These should be called from main thread procedure ProcessThreadEvents(SenderThread: TVFSCallbackThread); implementation uses SysUtils, DateUtils, StrUtils, UConfig, UOverwrite, ULocale, UFileAssoc, UCoreClasses, URemoteWait, UMain, UGnome, UNewDir, UProgress, crc; (********************************************************************************************************************************) constructor TVFSCallbackThread.Create(CreateSuspended: boolean); begin inherited Create(CreateSuspended); APlugin := nil; VFSCallbackEvent := TSimpleEvent.Create; VFSAskQuestion_Display := False; VFSAskPassword_Display := False; VFSCallbackCancelled := False; VFSConnectionManagerMode := False; VFSQuickConnectMode := False; DialogsParentWindow := FMain; FFinished := False; FCancelled := False; end; destructor TVFSCallbackThread.Destroy; begin VFSCallbackEvent.Free; inherited Destroy; end; procedure TVFSCallbackThread.PrepareExecute; begin FThreadID := pthread_self; VFSCallbackCancelled := False; end; (********************************************************************************************************************************) procedure vfs_ask_question_callback(const AMessage: PChar; const Choices: PPChar; choice: PInteger; cancel_choice: Integer; user_data: Pointer); cdecl; var Thread: TVFSCallbackThread; begin Thread := user_data; if (Thread = nil) { or (not (Thread is TVFSCallbackThread))} then begin DebugMsg(['(ERROR): vfs_ask_question_callback: user_data is not TVFSCallbackThread, exiting.']); Exit; end; if Thread.FCancelled then begin DebugMsg(['!! (WARNING): vfs_ask_question_callback: FCancelRequested.']); if (choice <> nil) then choice^ := -1; Thread.VFSCallbackCancelled := True; Exit; end; if pthread_self = Application.ThreadID then begin DebugMsg(['!! (WARNING): vfs_ask_question_callback called from the main thread, expected spawn from a TVFSCallbackThread']); HandleVFSAskQuestionCallback(Thread.DialogsParentWindow.FWidget, AMessage, Choices, choice); if (choice <> nil) then Thread.VFSCallbackCancelled := (choice^ < 0) or (choice^ = cancel_choice); Exit; end; if pthread_self = Thread.FThreadID then begin DebugMsg(['******* vfs_ask_question_callback spawned, user_data = ', user_data, ', ThreadID = ', pthread_self]); Thread.VFSAskQuestion_Message := AMessage; Thread.VFSAskQuestion_Choices := Choices; Thread.VFSAskQuestion_Choice := choice; Thread.VFSAskQuestion_Display := True; Thread.VFSCallbackEvent.ResetEvent; Thread.VFSCallbackEvent.WaitFor(INFINITE); DebugMsg(['******* thread: resuming...']); if (choice <> nil) then Thread.VFSCallbackCancelled := (choice^ < 0) or (choice^ = cancel_choice); Exit; end; DebugMsg(['!! (ERROR): vfs_ask_question_callback spawned neither from the main thread nor from active TVFSCallbackThread, dropping the callback to prevent data corruption.']); DebugMsg([' ThreadID = 0x', IntToHex(pthread_self, 16), ', TVFSCallbackThread 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; const default_password: PChar; flags: TVFSAskPasswordFlags; username, password: PPChar; anonymous: Pgboolean; domain: PPChar; password_save: PVFSPasswordSave; user_data: Pointer): gboolean; cdecl; var Thread: TVFSCallbackThread; def_pass: PChar; begin Result := False; Thread := user_data; if (Thread = nil) { or (not (Thread is TVFSCallbackThread))} then begin DebugMsg(['(ERROR): vfs_ask_question_callback: user_data is not TVFSCallbackThread, exiting.']); Exit; end; if Thread.FCancelled then begin DebugMsg(['!! (WARNING): vfs_ask_password_callback: FCancelRequested.']); Result := False; Thread.VFSCallbackCancelled := True; Exit; end; def_pass := default_password; // Disable password saving if requested if ConfConnMgrDoNotSynchronizeKeyring then begin flags := flags and (not VFS_ASK_PASSWORD_SAVING_SUPPORTED); if password_save <> nil then password_save^ := VFS_PASSWORD_SAVE_NEVER; end; if ConfConnMgrDoNotSavePasswords then flags := flags and (not VFS_ASK_PASSWORD_SAVE_INTERNAL) else if Thread.VFSConnectionManagerMode then flags := flags or VFS_ASK_PASSWORD_SAVE_INTERNAL; // Use stored password, if previously set if (((flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE) or Thread.VFSConnectionManagerMode or Thread.VFSQuickConnectMode) and (password <> nil) and (Thread.AEngine is TVFSEngine) and (Length((Thread.AEngine as TVFSEngine).Password) > 0) then begin if not (Thread.AEngine as TVFSEngine).PasswordUsed then begin DebugMsg([' (II) vfs_ask_password_callback: reusing manually set password']); password^ := g_strdup(PChar((Thread.AEngine as TVFSEngine).Password)); (Thread.AEngine as TVFSEngine).PasswordUsed := True; if (password_save <> nil) and Thread.VFSConnectionManagerMode then if ConfConnMgrDoNotSynchronizeKeyring then password_save^ := VFS_PASSWORD_SAVE_NEVER else password_save^ := VFS_PASSWORD_SAVE_PERMANENTLY; Thread.VFSCallbackCancelled := False; Result := True; Exit; end else if (flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE then def_pass := PChar((Thread.AEngine as TVFSEngine).Password); end; // Ask for password if pthread_self = Application.ThreadID then begin DebugMsg(['!! (WARNING): vfs_ask_password_callback called from the main thread, expected spawn from a TVFSCallbackThread']); Result := HandleVFSAskPasswordCallback(Thread.DialogsParentWindow.FWidget, AMessage, default_user, default_domain, def_pass, flags, username, password, anonymous, domain, password_save); Thread.VFSCallbackCancelled := Result = False; end else if pthread_self = Thread.FThreadID then begin DebugMsg(['******* vfs_ask_password_callback spawned, user_data = ', user_data, ', ThreadID = ', pthread_self, ', Application.ThreadID = ', Application.ThreadID]); Thread.VFSAskPassword_Message := AMessage; Thread.VFSAskPassword_default_user := default_user; Thread.VFSAskPassword_default_domain := default_domain; Thread.VFSAskPassword_default_password := def_pass; 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.ResetEvent; Thread.VFSCallbackEvent.WaitFor(INFINITE); DebugMsg(['******* thread: resuming...']); Result := Thread.VFSAskPassword_Result; Thread.VFSCallbackCancelled := Result = False; end else begin DebugMsg(['!! (ERROR): vfs_ask_password_callback spawned neither from the main thread nor from active TVFSCallbackThread, dropping the callback to prevent data corruption.']); DebugMsg([' ThreadID = 0x', IntToHex(pthread_self, 16), ', TVFSCallbackThread ID = 0x', IntToHex(Thread.FThreadID, 16), ', Application.ThreadID = 0x', IntToHex(Application.ThreadID, 16)]); end; // Save password back to the engine if Result and (password <> nil) and (strlen(password^) > 0) and (Thread.AEngine is TVFSEngine) and (((flags and VFS_ASK_PASSWORD_ARCHIVE_MODE) = VFS_ASK_PASSWORD_ARCHIVE_MODE) or (Thread.VFSConnectionManagerMode and (password_save <> nil) and (password_save^ = VFS_PASSWORD_SAVE_PERMANENTLY))) then begin (Thread.AEngine as TVFSEngine).Password := string(password^); (Thread.AEngine as TVFSEngine).PasswordUsed := True; end; // Strip password saving if requested if ConfConnMgrDoNotSynchronizeKeyring and (password_save <> nil) then password_save^ := VFS_PASSWORD_SAVE_NEVER; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.Execute; begin PrepareExecute; try case JobType of WORKER_JOB_DUMMY: DummyThreadWorker; WORKER_JOB_DELETE: DeleteFilesWorker; WORKER_JOB_COPY, WORKER_JOB_MOVE, WORKER_JOB_EXTRACT_TO_TEMP: CopyFilesWorker; WORKER_JOB_MERGE: MergeFilesWorker; WORKER_JOB_SPLIT: SplitFilesWorker; WORKER_JOB_CHMOD: ChmodFilesWorker; WORKER_JOB_CHOWN: ChownFilesWorker; end; finally FFinished := True; end; end; constructor TWorkerThread.Create; begin inherited Create(True); FreeOnTerminate := False; FGUIMutex := TCriticalSection.Create; FCallbackLockEvent := TSimpleEvent.Create; DataList := nil; SelectedItem := nil; FShowCancelMessage := False; FDialogShowDirDelete := False; FDialogShowOverwrite := False; FDialogShowNewDir := False; FDialogShowMsgBox := False; ErrorHappened := False; FGUIChanged := False; FCopyProgressFunc := nil; JobType := WORKER_JOB_DUMMY; // Defaults, keep in sync with class interface CopyTargetPath := ''; FCopySkipAllErrors := False; QuickRenameDataItem := nil; ExtractFromVFSAll := False; ExtractFile := ''; ChmodMode := 0; ChmodRecurseType := -1; ChownUID := 0; ChownGID := 0; ChownRecursive := False; MergeTargetCRC := 0; MergeHasInitialCRC := False; MergeTargetFinalName := ''; MergeTargetSize := 0; MergeSourceFile := ''; MergeTargetPath := ''; SplitDeleteTarget := False; SplitMaxSize := 0; SplitSourceFile := ''; SplitTargetPath := ''; end; destructor TWorkerThread.Destroy; begin FGUIMutex.Free; FCallbackLockEvent.Free; inherited Destroy; end; procedure TWorkerThread.UpdateProgress1(const Progress: Int64; const ProgressText: string); begin // DebugMsg([' ** TWorkerThread.UpdateProgress1(Progress = ', Progress, ', ProgressText = ', ProgressText]); FProgress1Pos := Progress; FProgress1Text := ProgressText; end; procedure TWorkerThread.UpdateProgress2(const Progress: Int64; const ProgressText: string); begin // DebugMsg([' ** TWorkerThread.UpdateProgress2(Progress = ', Progress, ', ProgressText = ', ProgressText]); FProgress2Pos := Progress; FProgress2Text := ProgressText; end; procedure TWorkerThread.SetProgress1Params(const ProgressMax: Int64); begin FProgress1Max := ProgressMax; end; procedure TWorkerThread.SetProgress2Params(const ProgressMax: Int64); begin FProgress2Max := ProgressMax; end; procedure TWorkerThread.UpdateCaption1(const CaptionText: string); begin FLabel1Text := CaptionText; end; procedure TWorkerThread.UpdateCaption2(const CaptionText: string); begin FLabel2Text := CaptionText; end; procedure TWorkerThread.CommitGUIUpdate; begin FGUIMutex.Acquire; // WriteLn('TWorkerThread.CommitGUIUpdate, ted mam lock ja! -- enter'); FGUIProgress1Pos := FProgress1Pos; FGUIProgress2Pos := FProgress2Pos; FGUIProgress1Max := FProgress1Max; FGUIProgress2Max := FProgress2Max; FGUIProgress1Text := FProgress1Text; FGUIProgress2Text := FProgress2Text; FGUILabel1Text := FLabel1Text; FGUILabel2Text := FLabel2Text; FGUIChanged := True; // Sleep(1000); // WriteLn('TWorkerThread.CommitGUIUpdate, ted mam lock ja! -- leave'); FGUIMutex.Release; end; function TWorkerThread.ShowDirDeleteDialog(ButtonsType: TFDirDeleteButtonSet; const Title, FileName: string; Error: PGError): integer; begin FDialogResultDirDelete := DIR_DELETE_CANCEL; FDirDeleteTitle := Title; FDirDeleteFileName := FileName; FDirDeleteError := Error; FDirDeleteButtonsType := ButtonsType; FDialogShowDirDelete := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultDirDelete; end; function TWorkerThread.ShowOverwriteDialog(ShowAppend: boolean; SourceItem, DestItem: PDataItem; const SourceFile, DestFile: string; var RenameStr: string): integer; begin FDialogResultOverwrite := OVERWRITE_CANCEL; FOverwriteShowAppend := ShowAppend; FOverwriteSourceItem := SourceItem; FOverwriteDestItem := DestItem; FOverwriteSourceFile := SourceFile; FOverwriteDestFile := DestFile; FDialogShowOverwrite := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultOverwrite; RenameStr := FOverwriteRenameStr; end; function TWorkerThread.ShowNewDirDialog(Caption, LabelCaption, Edit: string): integer; begin FNewDirCaption := Caption; FNewDirLabel := LabelCaption; FNewDirEdit := Edit; FDialogShowNewDir := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultNewDir; end; function TWorkerThread.ShowMessageBox(const Text: string; Buttons: TMessageButtons; Style: TMessageStyle; Default, Escape: TMessageButton): TMessageButton; begin FMsgBoxText := Text; FMsgBoxButtons := Buttons; FMsgBoxStyle := Style; FMsgBoxDefault := Default; FMsgBoxEscape := Escape; FDialogShowMsgBox := True; FCallbackLockEvent.ResetEvent; FCallbackLockEvent.WaitFor(INFINITE); Result := FDialogResultMsgBox; end; (********************************************************************************************************************************) procedure TWorkerThread.PrepareJobFilesFromPanel(AList: TList; DoNotRecurse: boolean); var i: longint; CurrPath: string; InputFiles: TStringList; begin InputFiles := TStringList.Create; CurrPath := IncludeTrailingPathDelimiter(AEngine.Path); // Process selected files first if DataList.Count > 0 then for i := 0 to DataList.Count - 1 do with PDataItem(DataList[i])^ do if (not UpDir) and Selected then InputFiles.Add(CurrPath + String(FName)); // If not files are selected, take into account the current active item if (InputFiles.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then InputFiles.Add(CurrPath + String(SelectedItem^.FName)); FillDirFiles(AEngine, AList, InputFiles, DoNotRecurse, True); InputFiles.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure ProcessThreadEvents(SenderThread: TVFSCallbackThread); var AFDirDelete: TFDirDelete; AFOverwrite: TFOverwrite; AFNewDir: TFNewDir; AFProgress: TFProgress; AFRemoteWait: TFRemoteWait; ParentDialogForm: TCustomGTKForm; b, ShowRemoteWait: boolean; StartTime: TDateTime; InfoLabelFormat: string; begin DebugMsg([' ** ProcessThreadEvents --begin']); ShowRemoteWait := False; AFProgress := nil; AFRemoteWait := nil; ParentDialogForm := SenderThread.DialogsParentWindow; StartTime := Now; if SenderThread is TWorkerThread then begin AFProgress := TFProgress.Create(SenderThread.DialogsParentWindow); ParentDialogForm := AFProgress; case (SenderThread as TWorkerThread).JobType of WORKER_JOB_DUMMY: AFProgress.Label1.Caption := ''; WORKER_JOB_DELETE: AFProgress.Label1.Caption := LANGDelete; WORKER_JOB_COPY: AFProgress.Label1.Caption := LANGCopySC; WORKER_JOB_MOVE: AFProgress.Label1.Caption := LANGMoveRenameSC; WORKER_JOB_EXTRACT_TO_TEMP: AFProgress.Label1.Caption := 'Extract:'; WORKER_JOB_MERGE: AFProgress.Label1.Caption := LANGMergeSC; WORKER_JOB_SPLIT: AFProgress.Label1.Caption := LANGSplitSC; WORKER_JOB_CHMOD: AFProgress.Label1.Caption := LANGChmodProgress; WORKER_JOB_CHOWN: AFProgress.Label1.Caption := LANGChownProgress; end; AFProgress.SetNumBars((SenderThread as TWorkerThread).JobType in [WORKER_JOB_COPY, WORKER_JOB_MOVE, WORKER_JOB_MERGE]); AFProgress.ProgressBar.Fraction := 0; AFProgress.ProgressBar2.Fraction := 0; AFProgress.ShowModal; end else if SenderThread is TOpenDirThread then begin AFRemoteWait := TFRemoteWait.Create(SenderThread.DialogsParentWindow); end; repeat b := False; // * TODO: transform to GMainLoop Sleep(ConstInternalProgressTimer); // Check for cancellation if ((AFProgress <> nil) and AFProgress.Cancelled) or ((AFRemoteWait <> nil) and AFRemoteWait.Cancelled) then SenderThread.FCancelled := True; // Display busy wait dialog after timeout for some operations if (AFRemoteWait <> nil) and (not ShowRemoteWait) and (MilliSecondsBetween(StartTime, Now) >= ConstRemoteWaitDialogDelay) then begin AFRemoteWait.ShowModal; ShowRemoteWait := True; ParentDialogForm := AFRemoteWait; end; // Update progress bars if SenderThread is TWorkerThread then with SenderThread as TWorkerThread do begin FGUIMutex.Acquire; if FGUIChanged then begin if FGUIProgress1Max > 1 then AFProgress.ProgressBar.Fraction := FGUIProgress1Pos / FGUIProgress1Max else AFProgress.ProgressBar.Fraction := 0; AFProgress.ProgressBar.Text := FGUIProgress1Text; AFProgress.Label2.Caption := FGUILabel1Text; if AFProgress.FTwoBars then begin if FGUIProgress2Max > 1 then AFProgress.ProgressBar2.Fraction := FGUIProgress2Pos / FGUIProgress2Max else AFProgress.ProgressBar2.Fraction := 0; AFProgress.ProgressBar2.Text := FGUIProgress2Text; AFProgress.Label3.Caption := FGUILabel2Text; end; AFProgress.ProgressBar.Max := FGUIProgress1Max; AFProgress.ProgressBar2.Max := FGUIProgress2Max; FGUIChanged := False; end; FGUIMutex.Release; end; Application.ProcessMessages; // VFS callbacks if SenderThread.VFSAskQuestion_Display then begin SenderThread.VFSAskQuestion_Display := False; DebugMsg(['ProcessProgressThread - Main thread: displaying question dialog']); HandleVFSAskQuestionCallback(ParentDialogForm.FWidget, SenderThread.VFSAskQuestion_Message, SenderThread.VFSAskQuestion_Choices, SenderThread.VFSAskQuestion_Choice); SenderThread.VFSCallbackEvent.SetEvent; end; if SenderThread.VFSAskPassword_Display then begin SenderThread.VFSAskPassword_Display := False; DebugMsg(['ProcessProgressThread - Main thread: displaying password prompt']); SenderThread.VFSAskPassword_Result := HandleVFSAskPasswordCallback(ParentDialogForm.FWidget, SenderThread.VFSAskPassword_Message, SenderThread.VFSAskPassword_default_user, SenderThread.VFSAskPassword_default_domain, SenderThread.VFSAskPassword_default_password, SenderThread.VFSAskPassword_flags, SenderThread.VFSAskPassword_username, SenderThread.VFSAskPassword_password, SenderThread.VFSAskPassword_anonymous, SenderThread.VFSAskPassword_domain, SenderThread.VFSAskPassword_password_save); SenderThread.VFSCallbackEvent.SetEvent; end; Application.ProcessMessages; // DirDelete dialogs if SenderThread is TWorkerThread then with SenderThread as TWorkerThread do try if FDialogShowDirDelete then begin AFDirDelete := nil; try AFDirDelete := TFDirDelete.Create(ParentDialogForm); AFDirDelete.AddButtons(FDirDeleteButtonsType); AFDirDelete.Label1.Caption := FDirDeleteTitle; AFDirDelete.Label2.Caption := FDirDeleteFileName; if FDirDeleteError <> nil then AFDirDelete.Label3.Caption := FDirDeleteError^.message; FDialogResultDirDelete := Integer(AFDirDelete.Run); if (FDirDeleteButtonsType = DIR_DELETE_SET_COPY_ERROR) and (FDialogResultDirDelete = DIR_DELETE_IGNORE) and (JobType = WORKER_JOB_MOVE) then case Application.MessageBox(LANGIgnoreError, [mbYes, mbNo{, mbCancel}], mbWarning, mbYes, mbNo) of mbNo: FDialogResultDirDelete := DIR_DELETE_IGNORE; mbCancel: FDialogResultDirDelete := DIR_DELETE_SKIP; end; finally AFDirDelete.Free; end; FDialogShowDirDelete := False; b := True; end; if FDialogShowOverwrite then begin AFOverwrite := nil; try AFOverwrite := TFOverwrite.Create(ParentDialogForm); AFOverwrite.AddButtons(FOverwriteShowAppend); case ConfSizeFormat of 5: InfoLabelFormat := '%s, %s'; else InfoLabelFormat := LANGOvewriteSBytesS; end; AFOverwrite.FromLabel.Caption := Format(LANGOverwriteS, [StrToUTF8(FOverwriteSourceItem^.FDisplayName)]); AFOverwrite.FromInfoLabel.Caption := Format(InfoLabelFormat, [FormatSize(FOverwriteSourceItem^.Size, 0), FormatDate(FOverwriteSourceItem^.mtime, True, True)]); AFOverwrite.ToLabel.Caption := Format(LANGWithFileS, [StrToUTF8(FOverwriteDestItem^.FDisplayName)]); AFOverwrite.ToInfoLabel.Caption := Format(InfoLabelFormat, [FormatSize(FOverwriteDestItem^.Size, 0), FormatDate(FOverwriteDestItem^.mtime, True, True)]); AFOverwrite.RenameStr := ExtractFileName(FOverwriteDestFile); AFOverwrite.SourceFile := FOverwriteSourceFile; AFOverwrite.DestFile := FOverwriteDestFile; FDialogResultOverwrite := Integer(AFOverwrite.Run); FOverwriteRenameStr := UTF8ToStr(AFOverwrite.RenameStr); finally AFOverwrite.Free; end; FDialogShowOverwrite := False; b := True; end; if FDialogShowNewDir then begin AFNewDir := nil; try AFNewDir := TFNewDir.Create(ParentDialogForm); AFNewDir.Caption := FNewDirCaption; AFNewDir.Label1.Caption := FNewDirLabel; AFNewDir.Entry.Text := FNewDirEdit; AFNewDir.Entry.SelectAll; FDialogResultNewDir := Integer(AFNewDir.Run); FNewDirEdit := AFNewDir.Entry.Text; finally AFNewDir.Free; end; FDialogShowNewDir := False; b := True; end; if FDialogShowMsgBox then begin FDialogResultMsgBox := Application.MessageBox(PGtkWindow(ParentDialogForm.FWidget), FMsgBoxText, FMsgBoxButtons, FMsgBoxStyle, FMsgBoxDefault, FMsgBoxEscape); FDialogShowMsgBox := False; b := True; end; finally // Unlock the waiting worker thread if b then FCallbackLockEvent.SetEvent; end; until SenderThread.FFinished; if SenderThread is TWorkerThread then with SenderThread as TWorkerThread do if FShowCancelMessage then begin if FCancelMessage = LANGUserCancelled then Application.MessageBox(PGtkWindow(ParentDialogForm.FWidget), FCancelMessage, [mbOK], mbWarning, mbNone, mbOK) else Application.MessageBox(PGtkWindow(ParentDialogForm.FWidget), FCancelMessage, [mbOK], mbError, mbNone, mbOK); end; // Close all dialogs if AFProgress <> nil then begin AFProgress.Close; AFProgress.Free; end; if AFRemoteWait <> nil then begin AFRemoteWait.Close; AFRemoteWait.Free; end; DebugMsg([' ** ProcessThreadEvents --end']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.DeleteFilesWorker; var SkipAll: boolean; // Return False to break the operation function HandleDelete(AFileRec: PDataItemSL): boolean; var Response: integer; Res: boolean; Error: PGError; begin Result := True; Error := nil; // DebugMsg(['Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); if AFileRec^.DataItem^.IsDir and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; Res := AEngine.Remove(String(AFileRec^.DataItem^.FName), @Error); // DebugMsg(['Result : ', Res]); if not Res then if SkipAll then Result := True else begin Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, 'Error deleting file/directory:', String(AFileRec^.DataItem^.FDisplayName), Error); if Error <> nil then g_error_free(Error); case Response of DIR_DELETE_SKIP : Result := True; DIR_DELETE_SKIP_ALL : begin SkipAll := True; Result := True; end; DIR_DELETE_RETRY : Result := HandleDelete(AFileRec); else Result := False; end; end; end; var i: longint; AList: TList; CurrPath: string; Fr: Single; Response: integer; DeleteAll, SkipToNext: boolean; begin SkipAll := False; AList := TList.Create; CurrPath := IncludeTrailingPathDelimiter(AEngine.Path); PrepareJobFilesFromPanel(AList, False); // * TODO: catch the error if not AEngine.ChangeDir(CurrPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); libc_chdir('/'); SetProgress1Params(AList.Count); CommitGUIUpdate; DeleteAll := False; SkipToNext := False; DebugWriteListSL(AList); if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); if AList.Count > 0 then for i := 0 to AList.Count - 1 do begin if FCancelled then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; Break; end; if SkipToNext and (PDataItemSL(AList[i])^.Level > 1) then Continue; if SkipToNext and (PDataItemSL(AList[i])^.Level = 1) and (not PDataItemSL(AList[i])^.Stage1) then begin SkipToNext := False; Continue; end; // Check for non-empty directory if (not DeleteAll) and (PDataItemSL(AList[i])^.Level = 1) and PDataItemSL(AList[i])^.Stage1 and PDataItemSL(AList[i])^.DataItem^.IsDir and (not PDataItemSL(AList[i])^.DataItem^.IsLnk) and (i < AList.Count - 2) and (PDataItemSL(AList[i + 1])^.Level = 2) then begin Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_NON_EMPTY, 'The directory is not empty, do you want to delete it with all its files and subdirectories?', string(PDataItemSL(AList[i])^.DataItem^.FDisplayName), nil); case Response of DIR_DELETE_DELETE : ; // Do nothing in this case - I will not bother with changing the structure; it works :-) DIR_DELETE_ALL : DeleteAll := True; DIR_DELETE_SKIP : SkipToNext := True; else Break; end; end; // Process delete if not HandleDelete(AList[i]) then Break; UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); CommitGUIUpdate; end; // Free the objects if AList.Count > 0 then for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; // * TODO: catch the error if not AEngine.ChangeDir(CurrPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) // Keep in sync with uVFSprototypes.pas/TVFSProgressCallback function vfs_copy_progress_callback(position: guint64; error: PGError; user_data: Pointer): gboolean; cdecl; begin Result := True; if not Assigned(user_data) then Exit; if Assigned(TWorkerThread(user_data).FCopyProgressFunc) then try Result := TWorkerThread(user_data).FCopyProgressFunc(user_data, position, error); except on E: Exception do DebugMsg(['*** Exception raised in vfs_copy_progress_callback(position=', position, ', user_data=', user_data, '): (', E.ClassName, '): ', E.Message]); end; end; // Keep in sync with UEngines.pas/TEngineProgressFunc function CopyFilesWorker_ProgressFunc(Sender: Pointer; BytesDone: Int64; Error: PGError): boolean; cdecl; begin Result := True; try if Assigned(Sender) and (TObject(Sender) is TWorkerThread) then with TWorkerThread(Sender) do begin if BytesDone = 0 then UpdateProgress1(0, '0%') else UpdateProgress1(BytesDone, Format('%d%%', [Round(BytesDone / FFileSize * 100)])); UpdateProgress2(FTotalDone + BytesDone, Format('%d%%', [Round((FTotalDone + BytesDone) / FTotalSize * 100)])); Result := not FCancelled; CommitGUIUpdate; end else DebugMsg(['*** CopyFilesWorker: Sender is not TWorkerThread']); except on E: Exception do DebugMsg(['*** Exception raised in ProgressFunc(Sender=', Sender, ', BytesDone=', BytesDone, '): (', E.ClassName, '): ', E.Message]); end; end; // Return True to ignore the error (Skip, Skip All, Ignore, Cancel) function CopyFilesWorker_ErrorFunc(Sender: Pointer; ErrorType, ErrorNum: integer; FileName: string): boolean; cdecl; var s, s2, s3: string; begin Result := False; with TWorkerThread(Sender) do begin if FCopySkipAllErrors then begin Result := True; Exit; end; case ErrorType of 0 : begin FCancelled := True; Exit; end; 1 : s := LANGMemoryAllocationFailed; 2 : s := LANGCannotOpenSourceFile; 3 : s := LANGCannotOpenDestinationFile; 4 : s := LANGCannotCloseDestinationFile; 5 : s := LANGCannotCloseSourceFile; 6 : s := LANGCannotReadFromSourceFile; 7 : s := LANGCannotWriteToDestinationFile; end; if (JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) then s2 := LANGCopyError else s2 := LANGMoveError; if ErrorType <> 1 then s3 := StrToUTF8(FileName) else s3 := ''; // * TODO: fix error string, port to GError case ShowDirDeleteDialog(DIR_DELETE_SET_COPY_ERROR, s, s3, nil) of DIR_DELETE_CANCEL : begin Result := False; FCancelled := True; end; DIR_DELETE_IGNORE : Result := True; DIR_DELETE_SKIP_ALL : begin FCopySkipAllErrors := True; { Skip All Err } Result := False; //** True? end; else Result := False; // Skip end; end; end; procedure TWorkerThread.CopyFilesWorker; var DefResponse: integer; // Global variables for this function SkipAll: boolean; // Returns True if file was successfully copied, if not, the file will be deleted in LocalCopyFile function ManualCopyFile(SourceFile, DestFile: string; Append: boolean): boolean; var fsrc, fdst: TEngineFileDes; BSize: integer; Buffer: Pointer; BytesDone, BytesRead, BytesWritten: Int64; Res: boolean; Error: PGError; begin DebugMsg(['ManualCopyFile: ', SourceFile, ' ---> ', DestFile]); Result := False; Error := nil; fsrc := SrcEngine.OpenFile(SourceFile, omRead, @Error); if fsrc = nil then begin // * TODO: set real error, also free it CopyFilesWorker_ErrorFunc(Self, 2, 1 { Error }, SourceFile); // Cannot open source file Exit; end; if Append then fdst := DestEngine.OpenFile(DestFile, omAppend, @Error) else fdst := DestEngine.OpenFile(DestFile, omWrite, @Error); if fdst = nil then begin // * TODO: set real error, also free it SrcEngine.CloseFile(fsrc, nil); CopyFilesWorker_ErrorFunc(Self, 3, 1 { Error }, SourceFile); // Cannot open target file Exit; end; BytesDone := 0; Res := True; BSize := DestEngine.GetBlockSize; Buffer := malloc(BSize); if Buffer = nil then begin CopyFilesWorker_ErrorFunc(Self, 1, errno, SourceFile); // Memory allocation failed libc_free(Buffer); Exit; end; memset(Buffer, 0, BSize); BytesWritten := 0; repeat BytesRead := SrcEngine.ReadFile(fsrc, Buffer, BSize, @Error); if (BytesRead = 0) and (Error <> nil) then // * TODO: set real error, also free it Res := CopyFilesWorker_ErrorFunc(Self, 6, 1 { Error }, SourceFile); // Cannot read from source file if BytesRead > 0 then begin Error := nil; BytesWritten := DestEngine.WriteFile(fdst, Buffer, BytesRead, @Error); if (BytesWritten < BytesRead) then // * TODO: set real error, also free it Res := CopyFilesWorker_ErrorFunc(Self, 7, 1 { Error }, DestFile); // Cannot write to source file end; Inc(BytesDone, BytesRead); if not CopyFilesWorker_ProgressFunc(Self, BytesDone, nil) then begin Res := False; Break; end; until (BytesRead = 0) or (BytesWritten < BytesRead); libc_free(Buffer); // * TODO: set real error, also free it if not DestEngine.CloseFile(fdst, nil) then begin CopyFilesWorker_ErrorFunc(Self, 4, errno, DestFile); // Cannot close target file Exit; end; // * TODO: set real error, also free it if not SrcEngine.CloseFile(fsrc, nil) then begin CopyFilesWorker_ErrorFunc(Self, 5, errno, SourceFile); // Cannot close source file Exit; end; Result := Res; end; // Returns True if the file was successfully copied and will be deleted on move function LocalCopyFile(SourceFile, DestFile: string; Append: boolean): boolean; var DataSrc, DataDest: PDataItem; begin Result := False; try AEngine := nil; FCopyProgressFunc := CopyFilesWorker_ProgressFunc; // local -> local if (SrcEngine is TLocalTreeEngine) and (DestEngine is TLocalTreeEngine) then Result := DestEngine.CopyFileIn(SourceFile, DestFile, Append, @CopyFilesWorker_ProgressFunc, Self) else // from local engine to VFS engine if (SrcEngine is TLocalTreeEngine) and (DestEngine is TVFSEngine) then begin AEngine := DestEngine; Result := (DestEngine as TVFSEngine).CopyFileInEx(SourceFile, DestFile, Append); end else // from VFS engine to local (most common use) if (SrcEngine is TVFSEngine) and (DestEngine is TLocalTreeEngine) then begin AEngine := SrcEngine; Result := (SrcEngine as TVFSEngine).CopyFileOutEx(SourceFile, DestFile, Append); end // VFS to VFS (not supported yet) else begin AEngine := SrcEngine; Result := ManualCopyFile(SourceFile, DestFile, Append); end; AEngine := nil; // Copy OK? (check size, otherwise delete target file) if (not Append) and (not Result) then begin // * TODO: check error DataSrc := SrcEngine.GetFileInfo(SourceFile, False, True, nil); if DataSrc = nil then Exit; // * TODO: check error DataDest := DestEngine.GetFileInfo(DestFile, False, True, nil); if (DataDest <> nil) and (DataSrc^.Size <> DataDest^.Size) then // * TODO: check error DestEngine.Remove(DestFile, nil); FreeDataItem(DataSrc); FreeDataItem(DataDest); end; except on E: Exception do DebugMsg(['*** Exception raised in LocalCopyFile(SourceFile=', SourceFile, ', DestFile=', DestFile, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); end; end; function IsOnSameFS(SrcPath, DestPath: string): boolean; begin if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and ((SrcEngine as TVFSEngine).ArchivePath <> '') and ((SrcEngine as TVFSEngine).ArchivePath = (DestEngine as TVFSEngine).ArchivePath) then Result := True else Result := DestEngine.IsOnSameFS(SrcPath, DestPath, False); end; function TwoSameFiles(Path1, Path2: string; TestCaseInsensitiveFS: boolean): boolean; begin if (SrcEngine.ClassName <> DestEngine.ClassName) then Result := False else if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and ((SrcEngine as TVFSEngine).ArchiveMode <> (DestEngine as TVFSEngine).ArchiveMode) then Result := False else if (SrcEngine is TVFSEngine) and (DestEngine is TVFSEngine) and (SrcEngine as TVFSEngine).ArchiveMode and (DestEngine as TVFSEngine).ArchiveMode and ((SrcEngine as TVFSEngine).ArchivePath <> '') and ((SrcEngine as TVFSEngine).ArchivePath <> (DestEngine as TVFSEngine).ArchivePath) then Result := False else if WideCompareStr(Path1, Path2) = 0 then Result := True else // * FIXME: causes stat errors, no need to check every file. Result := TestCaseInsensitiveFS and DestEngine.TwoSameFiles(Path1, Path2, False); end; function DoOperation(AFileRec: PDataItemSL; const Dst: string; var ErrorKind: integer; const Append: boolean): integer; begin ErrorKind := 0; Result := 0; try with AFileRec^ do begin if DataItem^.IsLnk then begin // Explicit copy the file if (JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) or (not IsOnSameFS(String(DataItem^.FName), ExtractFileDir(Dst))) then begin // * TODO: check error ErrorKind := Ord(DestEngine.MakeSymLink(Dst, String(DataItem^.LnkPointTo), nil)); // if ErrorKind <> 0 then Result := ERRCreateLink; if JobType = WORKER_JOB_MOVE then begin // * TODO: check error ErrorKind := Ord(SrcEngine.Remove(String(DataItem^.FName), nil)); // if ErrorKind <> 0 then Result := ERRRemove; end; end else begin // Move the file // * TODO: check error ErrorKind := Ord(DestEngine.RenameFile(String(DataItem^.FName), Dst, nil)); // if ErrorKind <> 0 then Result := ERRCopyMove; end; end else // is not link if (JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) then begin // Copy mode if LocalCopyFile(String(DataItem^.FName), Dst, Append) then begin if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; // * TODO: check error DestEngine.Chmod(Dst, DataItem^.Mode, nil); DestEngine.Chown(Dst, DataItem^.UID, DataItem^.GID, nil); DestEngine.ChangeTimes(Dst, DataItem^.mtime, DataItem^.atime, nil); end; end else // Move mode if IsOnSameFS(String(DataItem^.FName), ExtractFileDir(Dst)) then begin if TwoSameFiles(String(DataItem^.FName), Dst, True) and (not TwoSameFiles(String(DataItem^.FName), Dst, False)) then begin DebugMsg(['*** Activating double-rename due to renaming on case-insensitive FS']); // * TODO: check error ErrorKind := Ord(DestEngine.RenameFile(String(DataItem^.FName), Dst + '_tcmd', nil)); if ErrorKind = 0 then ErrorKind := Ord(DestEngine.RenameFile(Dst + '_tcmd', Dst, nil)); end else ErrorKind := Ord(DestEngine.RenameFile(String(DataItem^.FName), Dst, nil)); // if ErrorKind <> 0 then Result := ERRCopyMove; end else begin if LocalCopyFile(String(DataItem^.FName), Dst, Append) then begin if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; // * TODO: check error DestEngine.Chmod(Dst, DataItem^.Mode, nil); DestEngine.Chown(Dst, DataItem^.UID, DataItem^.GID, nil); DestEngine.ChangeTimes(Dst, DataItem^.mtime, DataItem^.atime, nil); if not FCancelled then begin ErrorKind := Ord(SrcEngine.Remove(String(DataItem^.FName), nil)); // if ErrorKind <> 0 then Result := ERRRemove; end; end; end; end; // DebugMsg(['(II) CopyFilesWorker.DoOperation: finished']); except on E: Exception do DebugMsg(['*** Exception raised in DoOperation(AFileRec=', AFileRec, ', Dst=', Dst, ', ErrorKind=', ErrorKind, ', Append=', Append, '): (', E.ClassName, '): ', E.Message]); end; end; // Return False to break the processing (Cancel) function HandleCopy(AFileRec: PDataItemSL; NewFilePath: string): boolean; var Res, Response, ErrorKind, r: integer; Item: PDataItem; s, s1, s3, cap: string; FromInfoLabel, ToInfoLabel, InfoLabelFormat: string; RenameStr: string; begin Result := True; try // Second stage - change permissions if (not AFileRec^.Stage1) and ((JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) or (not AFileRec^.ForceMove)) then with AFileRec^ do begin if IsOnRO and ConfClearReadOnlyAttr and (DataItem^.Mode and S_IWUSR = 0) then DataItem^.Mode := DataItem^.Mode or S_IWUSR; // * TODO: check error DestEngine.Chmod(NewFilePath, DataItem^.Mode, nil); DestEngine.Chown(NewFilePath, DataItem^.UID, DataItem^.GID, nil); DestEngine.ChangeTimes(NewFilePath, DataItem^.mtime, DataItem^.atime, nil); if JobType = WORKER_JOB_MOVE then SrcEngine.Remove(String(DataItem^.FName), nil); // Remove directory Exit; end; // First stage - copy data if AFileRec^.DataItem^.IsDir then begin Res := 0; if AFileRec^.ForceMove and (JobType = WORKER_JOB_MOVE) then begin if TwoSameFiles(ExcludeTrailingPathDelimiter(string(AFileRec^.DataItem^.FName)), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), True) and (not TwoSameFiles(ExcludeTrailingPathDelimiter(string(AFileRec^.DataItem^.FName)), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), False)) then begin DebugMsg(['*** Activating double-rename due to renaming on case-insensitive FS']); // * TODO: check error ErrorKind := Ord(DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd', nil)); if ErrorKind = 0 then ErrorKind := ord(DestEngine.RenameFile(ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)) + '_tcmd', ExcludeTrailingPathDelimiter(string(AFileRec^.ADestination)), nil)); end else ErrorKind := Ord(DestEngine.RenameFile(string(AFileRec^.DataItem^.FName), string(AFileRec^.ADestination), nil)); { if ErrorKind <> 0 then Res := ERRCopyMove else Res := 0; } end else if not DestEngine.DirectoryExists(NewFilePath, False) then begin // * TODO: check error ErrorKind := Ord(DestEngine.MakeDir(NewFilePath, nil)); { if ErrorKind <> 0 then Res := ERRMkDir else Res := 0; } end; end else begin // not a directory if not DestEngine.DirectoryExists(ExtractFileDir(NewFilePath), False) then // * TODO: check error DestEngine.MakeDir(ExtractFileDir(NewFilePath), nil); SetProgress1Params(AFileRec^.DataItem^.Size + Ord(AFileRec^.DataItem^.Size = 0)); FFileSize := AFileRec^.DataItem^.Size; CopyFilesWorker_ProgressFunc(Self, 0, nil); Res := 0; if DestEngine.FileExists(NewFilePath, False) and (not ((JobType = WORKER_JOB_MOVE) and (not TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, False)) and TwoSameFiles(NewFilePath, AFileRec^.DataItem^.FName, True))) then begin Response := DefResponse; // * TODO: check error --> display dialog // * TODO: should be SrcEngine? Item := DestEngine.GetFileInfo(NewFilePath, False, True, nil); if Item = nil then begin DebugMsg(['Something went terribly wrong during copy - Item := DestEngine.GetFileInfoSL(NewFilePath) == NULL!']); Result := False; Exit; end; if Response = 0 then begin case ConfSizeFormat of 5: InfoLabelFormat := '%s, %s'; else InfoLabelFormat := LANGOvewriteSBytesS; end; RenameStr := ExtractFileName(NewFilePath); Response := ShowOverwriteDialog(JobType in [WORKER_JOB_COPY], Item, AFileRec^.DataItem, NewFilePath, AFileRec^.DataItem^.FName, RenameStr); case Response of // OVERWRITE_OVERWRITE // OVERWRITE_SKIP OVERWRITE_OVERWRITE_ALL, OVERWRITE_OVERWRITE_ALL_OLDER, OVERWRITE_SKIP_ALL: DefResponse := Response; OVERWRITE_CANCEL, 124 {Close Window}, 255: begin Result := False; Exit; end; OVERWRITE_RENAME: begin NewFilePath := Copy(NewFilePath, 1, LastDelimiter(PathDelim, NewFilePath)) + RenameStr; Result := HandleCopy(AFileRec, NewFilePath); Exit; end; OVERWRITE_APPEND: begin Res := DoOperation(AFileRec, NewFilePath, ErrorKind, True); end; end; end; // Remove destination file if exists and should be overwritten if (Response in [OVERWRITE_OVERWRITE, OVERWRITE_OVERWRITE_ALL]) or ((Response = OVERWRITE_OVERWRITE_ALL_OLDER) and (Item^.mtime < AFileRec^.DataItem^.mtime)) then begin // * TODO: check error r := ord(DestEngine.Remove(NewFilePath, nil)); while r <> 0 do begin // * TODO: check error, port to GError Res := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, 'The file could not be deleted', StrToUTF8(String(NewFilePath)), nil); case Res of DIR_DELETE_SKIP: begin Result := True; Exit; end; // * TODO: check error DIR_DELETE_RETRY: r := Ord(DestEngine.Remove(NewFilePath, nil)); DIR_DELETE_CANCEL, 124, 255: begin Result := False; Exit; end; end; end; Res := DoOperation(AFileRec, NewFilePath, ErrorKind, False); end; end else Res := DoOperation(AFileRec, NewFilePath, ErrorKind, False); end; // Error handling if (Res <> 0) and (not SkipAll) then begin if (JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP]) then cap := LANGCopy else cap := LANGMove; // * TODO: port to GError { case Res of ERRCreateLink: begin s1 := LANGTheSymbolicLink; if ErrorKind = 0 then s3 := LANGCouldNotBeCreated else s3 := Format(LANGCouldNotBeCreatedS, [GetErrorString(ErrorKind)]); end; ERRMkDir: begin s1 := LANGTheDirectory; if ErrorKind = 0 then s3 := LANGCouldNotBeCreated else s3 := Format(LANGCouldNotBeCreatedS, [GetErrorString(ErrorKind)]); end; ERRRemove: begin if AFileRec^.DataItem^.IsDir then s1 := LANGTheDirectory else if AFileRec^.DataItem^.IsLnk then s1 := LANGTheSymbolicLink else s1 := LANGTheFile; if ErrorKind = 0 then s3 := LANGCouldNotBeDeleted else s3 := Format(LANGCouldNotBeDeletedS, [GetErrorString(ErrorKind)]); end; ERRCopyMove: begin if ParamBool3 then s1 := LANGCannotCopyFile else s1 := LANGCannotMoveFile; if ErrorKind = 0 then s3 := '' else s3 := GetErrorString(ErrorKind); end; end; } Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, s1, StrToUTF8(String(NewFilePath)), nil); case Response of DIR_DELETE_SKIP : Result := True; // Skip DIR_DELETE_RETRY : Result := HandleCopy(AFileRec, NewFilePath); // Retry DIR_DELETE_SKIP_ALL : begin // Skip All SkipAll := True; Result := True; end; 0, 124, 255 : Result := False; // Cancel end; end; // DebugMsg(['(II) CopyFilesWorker.HandleCopy: finished']); except on E: Exception do DebugMsg(['*** Exception raised in HandleCopy(AFileRec=', AFileRec, ', NewFilePath=', NewFilePath, '): (', E.ClassName, '): ', E.Message]); end; end; // Can be called only once, otherwise sorting will fail and extract errors may appear // TODO: make this universal // TODO: this is complete mess, make it more clear procedure HandleProcessPattern(AList: TList; CurrPath, FullPath, ParamFileName: string; ParamDir, Ren: boolean); var s, s2: string; b, CaseInsensitiveRename: boolean; Info: PDataItemSL; InputFiles: TStringList; begin InputFiles := TStringList.Create; if not Ren then begin InputFiles.Add(FullPath); end else begin s := ProcessPattern(DestEngine, CopyTargetPath, CurrPath, ParamFileName, ParamDir); CaseInsensitiveRename := (WideCompareStr(CopyTargetPath, ParamFileName) <> 0) and (WideCompareText(CopyTargetPath, ParamFileName) = 0) and ParamDir and DestEngine.TwoSameFiles(IncludeTrailingPathDelimiter(CurrPath) + CopyTargetPath, IncludeTrailingPathDelimiter(CurrPath) + ParamFileName, False); // DebugMsg(['HandleProcessPattern: s = ', s]); b := False; if ParamDir then begin b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s), False) and (not CaseInsensitiveRename); if (not b) and (s <> '/') then begin s2 := ExcludeTrailingPathDelimiter(s); s2 := ExcludeTrailingPathDelimiter(Copy(s2, 1, LastDelimiter('/', s2))); b := DestEngine.DirectoryExists(ExcludeTrailingPathDelimiter(s2), False); end; end; if (not ParamDir) or (ParamDir and b and IsOnSameFS(ExcludeTrailingPathDelimiter(FullPath), s2)) then begin Info := GetFileInfoSL(SrcEngine, FullPath); if Info = nil then begin DebugMsg(['$$$ Copy: Something went wrong while building the filelist...']); ErrorHappened := True; end else begin Info^.ADestination := strdup(PChar(s)); Info^.ForceMove := True; AList.Add(Info); end; end else InputFiles.Add(FullPath); end; FillDirFiles(SrcEngine, AList, InputFiles, False, True); InputFiles.Free; end; var i: longint; List: TList; CurrPath, SaveDestPath, SaveSrcPath, s: string; StartPassed: boolean; begin List := TList.Create; List.Clear; ErrorHappened := False; SaveSrcPath := ''; CurrPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SaveDestPath := DestEngine.Path; CopyTargetPath := ExcludeTrailingPathDelimiter(CopyTargetPath); if CopyTargetPath = '' then CopyTargetPath := PathDelim; // '/' // Prepare list of files to copy if JobType = WORKER_JOB_EXTRACT_TO_TEMP then begin if not ExtractFromVFSAll then HandleProcessPattern(List, CurrPath, ExtractFile, ExtractFileName(ExtractFile), False, False) else begin SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SrcEngine.SetPath('/'); CurrPath := '/'; HandleProcessPattern(List, '/', '/', '', True, False); end; end else if QuickRenameDataItem <> nil then begin // Quick-Rename with QuickRenameDataItem^ do HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), True); end else begin // Not Quick-Rename if JobType <> WORKER_JOB_EXTRACT_TO_TEMP then begin if DataList.Count > 0 then for i := 0 to DataList.Count - 1 do with PDataItem(DataList[i])^ do if (not UpDir) and Selected then HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), JobType = WORKER_JOB_MOVE); if (List.Count = 0) and Assigned(SelectedItem) and (not SelectedItem^.UpDir) then with SelectedItem^ do HandleProcessPattern(List, CurrPath, CurrPath + String(FName), String(FName), IsDir and (not IsLnk), JobType = WORKER_JOB_MOVE); end else begin // Extract from VFS mode DebugMsg(['CopyFilesWorker: Should not be reached']); if (not ExtractFromVFSAll) and Assigned(SelectedItem) then HandleProcessPattern(List, CurrPath, CurrPath + String(SelectedItem^.FName), String(SelectedItem^.FName), SelectedItem^.IsDir and (not SelectedItem^.IsLnk), JobType = WORKER_JOB_MOVE) else begin SaveSrcPath := IncludeTrailingPathDelimiter(SrcEngine.Path); SrcEngine.SetPath('/'); CurrPath := '/'; HandleProcessPattern(List, '/', '/', '', True, False); end; end; end; { 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('/'); // Compute total size of files to copy FTotalSize := 0; FTotalDone := 0; if List.Count > 0 then for i := 0 to List.Count - 1 do if PDataItemSL(List[i])^.Stage1 and (PDataItemSL(List[i])^.DataItem^.Size > 0) and (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) then Inc(FTotalSize, PDataItemSL(List[i])^.DataItem^.Size); SrcEngine.BlockSize := ComputeBlockSize(FTotalSize); DestEngine.BlockSize := ComputeBlockSize(FTotalSize); // Prepare the Progress window SetProgress2Params(FTotalSize + Ord(FTotalSize = 0)); UpdateProgress1(0, '0%'); UpdateProgress2(0, '0%'); CommitGUIUpdate; DefResponse := 0; SkipAll := False; FCopySkipAllErrors := False; if List.Count > 0 then begin StartPassed := True; if SrcEngine is TVFSEngine then StartPassed := StartPassed and (SrcEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, Self); if DestEngine is TVFSEngine then StartPassed := StartPassed and (DestEngine as TVFSEngine).StartCopyOperation(@vfs_ask_question_callback, @vfs_ask_password_callback, @vfs_copy_progress_callback, Self); if StartPassed then for i := 0 to List.Count - 1 do begin if Assigned(PDataItemSL(List[i])^.ADestination) then s := string(PDataItemSL(List[i])^.ADestination) else begin s := ProcessPattern(DestEngine, CopyTargetPath, CurrPath, Copy(PDataItemSL(List[i])^.DataItem^.FName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.DataItem^.FName) - Length(CurrPath)), PDataItemSL(List[i])^.DataItem^.IsDir and (not PDataItemSL(List[i])^.DataItem^.IsLnk)); // DebugMsg(['s2 = ', Copy(PDataItemSL(List[i])^.AName, Length(CurrPath) + 1, Length(PDataItemSL(List[i])^.AName) - Length(CurrPath)), ', s = ', s]); end; if not (SrcEngine is TVFSEngine) then UpdateCaption1(Format(LANGFromS, [string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])) else if (SrcEngine as TVFSEngine).ArchiveMode then UpdateCaption1(Format(LANGFromS, [Format(ConstFullPathFormatStr, [(SrcEngine as TVFSEngine).ArchivePath, string(PDataItemSL(List[i])^.DataItem^.FDisplayName)])])) else UpdateCaption1(Format(LANGFromS, [GetURIPrefix((SrcEngine as TVFSEngine).GetPathURI) + StrToUTF8(string(PDataItemSL(List[i])^.DataItem^.FDisplayName))])); if not (DestEngine is TVFSEngine) then UpdateCaption2(Format(LANGToS, [StrToUTF8(s)])) else if (DestEngine as TVFSEngine).ArchiveMode then UpdateCaption2(Format(LANGToS, [Format(ConstFullPathFormatStr, [(DestEngine as TVFSEngine).ArchivePath, StrToUTF8(s)])])) else UpdateCaption2(Format(LANGToS, [GetURIPrefix((DestEngine as TVFSEngine).GetPathURI) + StrToUTF8(s)])); CommitGUIUpdate; if TwoSameFiles(s, string(PDataItemSL(List[i])^.DataItem^.FName), (JobType in [WORKER_JOB_COPY, WORKER_JOB_EXTRACT_TO_TEMP])) and (not PDataItemSL(List[i])^.DataItem^.IsDir) then begin FCancelMessage := LANGCannotCopyFileToItself; FShowCancelMessage := True; ErrorHappened := True; Break; end; // * FIXME: why the hell we had something like this here?? // if s <> string(PDataItemSL(List[i])^.DataItem^.FName) then if not HandleCopy(List[i], s) then begin ErrorHappened := True; Break; end; if (not PDataItemSL(List[i])^.DataItem^.IsDir) and (not PDataItemSL(List[i])^.DataItem^.IsLnk) then Inc(FTotalDone, PDataItemSL(List[i])^.DataItem^.Size); if FCancelled then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; ErrorHappened := True; Break; end; end; // We need to ensure these to be called in case of error if SrcEngine is TVFSEngine then (SrcEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, Self); if DestEngine is TVFSEngine then (DestEngine as TVFSEngine).StopCopyOperation(@vfs_copy_progress_callback, Self); end; // Free the objects if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItemSL(List[i])); List.Clear; List.Free; // * TODO: check error if not DestEngine.ChangeDir(SaveDestPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); if SaveSrcPath <> '' then CurrPath := SaveSrcPath; // * TODO: check error if not SrcEngine.ChangeDir(CurrPath, nil) then DebugMsg(['*** WARNING: Cannot change to the origin location, strange behaviour might occur.']); DebugMsg(['(II) CopyFilesWorker: finished']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.MergeFilesWorker; var FD: TEngineFileDes; Count, MergeBlockSize: integer; Buffer: Pointer; CurrentCRC: LongWord; PrivateCancel: boolean; SizeDone: Int64; TargetName: string; Error: PGError; function PasteFile(FName: string): boolean; var FDR: TEngineFileDes; wCount: integer; Stat: PDataItem; begin Result := False; if MergeHasInitialCRC then UpdateCaption2(Format(LANGToS, [StrToUTF8(FName)])) else UpdateCaption1(Format(LANGFromS, [StrToUTF8(FName)])); UpdateProgress1(0, '0 %'); CommitGUIUpdate; // * TODO: check error Stat := AEngine.GetFileInfo(FName, True, True, nil); if not Assigned(Stat) then Exit; SetProgress1Params(Stat^.Size); FreeDataItem(Stat); // * TODO: check error Error := nil; FDR := AEngine.OpenFile(FName, omRead, @Error); if FDR = nil then Exit; repeat // * TODO: check error Count := AEngine.ReadFile(FDR, Buffer, MergeBlockSize, @Error); if Error <> nil then begin AEngine.CloseFile(FD, nil); Exit; end; // * TODO: check error wCount := AEngine.WriteFile(FD, Buffer, Count, @Error); if (Error <> nil) or (Count <> wCount) then begin FCancelMessage := Format(LANGAnErrorOccuredWhileWritingFileSS, [ExtractFileName(TargetName), Error^.message]); FShowCancelMessage := True; PrivateCancel := True; Result := True; // Fake this to don't show next disc dialog Exit; end; CurrentCRC := CRC32(CurrentCRC, Buffer, Count); UpdateProgress1(FProgress1Pos + Count, Format('%d %%', [Trunc((FProgress1Pos + Count) / FProgress1Max * 100)])); Inc(SizeDone, Count); if MergeHasInitialCRC then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FProgress2Max * 100)])); CommitGUIUpdate; until (Count < MergeBlockSize) or FCancelled; // * TODO: set real error, also free it AEngine.CloseFile(FDR, nil); Result := True; end; var CurrFile, SourcePath, TargetFinalName: string; HasFinalCRC, b: boolean; Stat: PDataItem; begin HasFinalCRC := MergeHasInitialCRC; TargetFinalName := MergeTargetFinalName; if (Length(MergeSourceFile) > 4) and (WideUpperCase(RightStr(MergeSourceFile, 4)) = '.CRC') then CurrFile := ChangeFileExt(ExtractFileName(MergeSourceFile), '.001') else CurrFile := ExtractFileName(MergeSourceFile); SourcePath := ExtractFilePath(MergeSourceFile); if MergeTargetFinalName = '' then MergeTargetFinalName := ChangeFileExt(ExtractFileName(MergeSourceFile), '.out'); TargetName := ProcessPattern(AEngine, MergeTargetPath, AEngine.Path, MergeTargetFinalName, False); if AEngine.FileExists(TargetName, False) then if ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(TargetName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes then begin // * TODO: check error { Error := Ord(Engine.Remove(TargetName, nil)); if Error <> 0 then begin FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(ExtractFileName(TargetName)), GetErrorString(Error)]); FShowCancelMessage := True; Exit; end; } end else Exit; // * TODO: check error Stat := AEngine.GetFileInfo(MergeSourceFile, True, True, nil); if Assigned(Stat) then MergeBlockSize := ComputeBlockSize(Stat^.Size) else MergeBlockSize := 65536*4; FreeDataItem(Stat); try Buffer := malloc(MergeBlockSize); memset(Buffer, 0, MergeBlockSize); except FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; FShowCancelMessage := True; Exit; end; // * TODO: check error FD := AEngine.OpenFile(TargetName, omWrite, @Error); if Error <> nil then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(TargetName), Error^.message]); FShowCancelMessage := True; libc_free(Buffer); Exit; end; CurrentCRC := 0; SizeDone := 0; PrivateCancel := False; if MergeHasInitialCRC then begin SetProgress2Params(MergeTargetSize); UpdateProgress2(0, '0 %'); UpdateCaption2(Format(LANGFromS, [StrToUTF8(TargetName)])); CommitGUIUpdate; end; { else begin Label2.XAlign := 0; Label2.XPadding := 20; end; } repeat b := PasteFile(IncludeTrailingPathDelimiter(SourcePath) + CurrFile); if not b then begin PrivateCancel := ShowNewDirDialog(LANGMergeCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, StrToUTF8(SourcePath)) <> integer(mbOK); if not PrivateCancel then begin SourcePath := UTF8ToStr(FNewDirEdit); if not HasFinalCRC then HasFinalCRC := CRCGetInfo(IncludeTrailingPathDelimiter(SourcePath) + CurrFile, AEngine, TargetFinalName, MergeTargetCRC, MergeTargetSize); Continue; end; end; try CurrFile := Copy(CurrFile, 1, LastDelimiter('.', CurrFile)) + Format('%.3d', [StrToInt( Copy(CurrFile, LastDelimiter('.', CurrFile) + 1, Length(CurrFile) - LastDelimiter('.', CurrFile))) + 1]); except CurrFile := ''; end; until (SizeDone = MergeTargetSize) or FCancelled or PrivateCancel {or ((not b) and (not HasInitialCRC))} or (CurrFile = ''); // * TODO: check error if (not MergeHasInitialCRC) and HasFinalCRC then AEngine.RenameFile(TargetName, IncludeTrailingPathDelimiter(ExtractFilePath(TargetName)) + TargetFinalName, nil); if FCancelled and (not PrivateCancel) then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; end; if not (FCancelled or PrivateCancel) then if HasFinalCRC then begin if CurrentCRC = MergeTargetCRC then ShowMessageBox(Format(LANGMergeOfSSucceeded, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK) else ShowMessageBox(LANGWarningCreatedFileFailsCRCCheck, [mbOK], mbWarning, mbNone, mbOK); end else ShowMessageBox(Format(LANGMergeOfSSucceeded_NoCRCFileAvailable, [StrToUTF8(ExtractFileName(TargetFinalName))]), [mbOK], mbInfo, mbNone, mbOK); // * TODO: set real error, also free it AEngine.CloseFile(FD, nil); libc_free(Buffer); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.SplitFilesWorker; const SplitBlockSize = 65536*4; var FD: TEngineFileDes; Error: PGError; FileCRC: LongWord; Buffer: Pointer; PrivateCancel: boolean; FilePath: string; SizeDone, TDF, FileSize, CurrSize: Int64; function WriteSplitPart(TargetFile: string; PartSize: Int64; var Written: Int64): boolean; var FDW: TEngineFileDes; Count, wCount, bl: integer; begin Result := False; Written := 0; // * TODO: check error FDW := AEngine.OpenFile(TargetFile, omWrite, @Error); DebugMsg(['-- Opening file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize]); if Error <> nil then Exit; if SplitMaxSize > 0 then begin UpdateCaption2(Format(LANGToS, [StrToUTF8(TargetFile)])); SetProgress1Params(PartSize); UpdateProgress1(0, '0 %'); end else UpdateCaption1(Format(LANGToS, [StrToUTF8(TargetFile)])); CommitGUIUpdate; repeat // * TODO: check error DebugMsg(['Seek to ', AEngine.FileSeek(FD, SizeDone + Written, @Error), ', Written = ', Written]); if Written + SplitBlockSize > PartSize then bl := PartSize - Written else bl := SplitBlockSize; // * TODO: check error Count := AEngine.ReadFile(FD, Buffer, bl, @Error); if (Error <> nil) or (Count <> bl) then begin // * TODO: set real error, also free it AEngine.CloseFile(FDW, nil); DebugMsg(['Read Error: ', Error^.message, ', Count = ', Count, ', bl = ', bl]); // if (Count <> bl) and (Error = 0) then Error := EIO; Exit; end; // * TODO: check error wCount := AEngine.WriteFile(FDW, Buffer, Count, @Error); Inc(Written, wCount); FileCRC := CRC32(FileCRC, Buffer, wCount); if (Error <> nil) or (Count <> wCount) then begin // * TODO: set real error, also free it AEngine.CloseFile(FDW, nil); // * TODO: check error DebugMsg(['Write Error: ', Error^.message, ', Count = ', Count, ', wCount = ', wCount]); // if (wCount <> Count) and (Error = 0) then Error := ENOSPC; Exit; end; UpdateProgress1(FProgress1Pos + wCount, Format('%d %%', [Trunc((FProgress1Pos + wCount) / FProgress1Max * 100)])); if SplitMaxSize > 0 then UpdateProgress2(FProgress2Pos + wCount, Format('%d %%', [Trunc((FProgress2Pos + wCount) / FProgress2Max * 100)])); CommitGUIUpdate; until (Written = PartSize) or FCancelled or PrivateCancel; // * TODO: set real error, also free it AEngine.CloseFile(FDW, nil); DebugMsg(['-- Closing file ', ExtractFileName(TargetFile), ', PartSize = ', PartSize, ', Written = ', Written]); Result := True; end; // Returns True if it should break the process function NewDiskQuestion: boolean; var x: Int64; xx: string; begin Result := False; AEngine.GetFileSystemInfo(FilePath, x, TDF, xx); // Calculate part size if SplitMaxSize = 0 then begin if FileSize - SizeDone > TDF then CurrSize := TDF else CurrSize := FileSize - SizeDone; end else if SizeDone + SplitMaxSize > FileSize then CurrSize := FileSize - SizeDone else CurrSize := SplitMaxSize; if (TDF < 512) {or (CurrSize < 512)} or (TDF < CurrSize) then begin DebugMsg(['-- New disk question']); libc_chdir('/'); PrivateCancel := ShowNewDirDialog(LANGSplitCaption, LANGPleaseInsertNextDiskOrGiveDifferentLocation, StrToUTF8(FilePath)) <> integer(mbOK); if not PrivateCancel then FilePath := UTF8ToStr(FNewDirEdit); Result := PrivateCancel; end; end; var i: integer; OriginalFName, st, FileName: string; ws: Int64; Stat: PDataItem; b: boolean; List: TList; x: Int64; xx: string; begin // * TODO: check error Stat := AEngine.GetFileInfo(SplitSourceFile, True, True, nil); if not Assigned(Stat) then begin FCancelMessage := Format(LANGCannotOpenFileS, [StrToUTF8(SplitSourceFile)]); FShowCancelMessage := True; Exit; end; if (SplitMaxSize > 0) and (Stat^.Size > SplitMaxSize * 999) then begin FCancelMessage := LANGCannotSplitTheFileToMoreThan999Parts; FShowCancelMessage := True; Exit; end; FileSize := Stat^.Size; FreeDataItem(Stat); SizeDone := 0; FileCRC := 0; List := TList.Create; try Buffer := malloc(SplitBlockSize); memset(Buffer, 0, SplitBlockSize); except FCancelMessage := LANGAnErrorOccuredWhileInitializingMemoryBlock; FShowCancelMessage := True; Exit; end; // * TODO: check error FD := AEngine.OpenFile(SplitSourceFile, omRead, @Error); if Error <> nil then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOpeningFileSS, [StrToUTF8(SplitSourceFile), Error^.message]); libc_free(Buffer); Exit; end; FilePath := IncludeTrailingPathDelimiter(ProcessPattern(AEngine, SplitTargetPath, AEngine.Path, '', True)); FileName := ExtractFileName(SplitSourceFile); OriginalFName := FileName; if Pos('.', FileName) > 1 then FileName := ChangeFileExt(FileName, '.001') else FileName := FileName + '.001'; PrivateCancel := False; if SplitMaxSize > 0 then begin SetProgress2Params(FileSize); UpdateProgress2(0, '0 %'); end else begin SetProgress1Params(FileSize); UpdateProgress1(0, '0 %'); end; UpdateCaption1(Format(LANGFromS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + OriginalFName)])); CommitGUIUpdate; repeat AEngine.GetFileSystemInfo(FilePath, x, TDF, xx); // Delete target files if necessary if SplitDeleteTarget and ((TDF < 512) or (TDF < FileSize) or (TDF < SplitMaxSize)) then try if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItem(List[i])); List.Clear; // * TODO: check error { Error := Engine.GetListing(List, FilePath, ConfShowDotFiles, False, False, nil); if (Error = 0) and (List.Count > 0) then begin st := ''; if List.Count < 6 then begin for i := 0 to List.Count - 1 do st := st + ' ' + string(PDataItem(List[i])^.FDisplayName) + #10; b := ShowMessageBox(Format(LANGThereAreSomeFilesInTheTargetDirectorySDoYouWantToDeleteThem, [StrToUTF8(st)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; end else b := ShowMessageBox(Format(LANGThereAreDFilesInTheTargetDirectoryDoYouWantToDeleteThem, [List.Count]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; if b then for i := 0 to List.Count - 1 do begin Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + string(PDataItem(List[i])^.FName)); if Error <> 0 then ShowMessageBox(Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath)) + string(PDataItem(List[i])^.FDisplayName), GetErrorString(Error)]), [mbOK], mbError, mbNone, mbOK); end; end; } except end; // Test for target file existence if AEngine.FileExists(IncludeTrailingPathDelimiter(FilePath) + FileName, False) then begin b := ShowMessageBox(Format(LANGTheTargetFileSAlreadyExistsDoYouWantToOverwriteIt, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName)]), [mbYes, mbNo], mbQuestion, mbNone, mbNo) = mbYes; if b then begin // * TODO: check error { Error := Engine.Remove(IncludeTrailingPathDelimiter(FilePath) + FileName); if Error <> 0 then begin FCancelMessage := Format(LANGTheTargetFileSCannotBeRemovedS, [StrToUTF8(IncludeTrailingPathDelimiter(FilePath) + FileName), GetErrorString(Error)]); FShowCancelMessage := True; PrivateCancel := True; Break; end; } end else begin PrivateCancel := True; Break; end; end; // Free space check if NewDiskQuestion then Break; // Writing ws := 0; if (CurrSize >= 512) and (TDF >= CurrSize) then begin b := WriteSplitPart(IncludeTrailingPathDelimiter(FilePath) + FileName, CurrSize, ws); if (not b) and (SplitMaxSize > 0) then begin FCancelMessage := Format(LANGAnErrorOccuredWhileOperationS, [Error^.message]); FShowCancelMessage := True; PrivateCancel := True; Break; end; Inc(SizeDone, ws); if SplitMaxSize > 0 then UpdateProgress2(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])) else UpdateProgress1(SizeDone, Format('%d %%', [Trunc(SizeDone / FileSize * 100)])); CommitGUIUpdate; end; // Free space check - New disk question after operation if NewDiskQuestion then Break; // Change filename if ws > 0 then try FileName := Copy(FileName, 1, LastDelimiter('.', FileName)) + Format('%.3d', [StrToInt(Copy(FileName, LastDelimiter('.', FileName) + 1, Length(FileName) - LastDelimiter('.', FileName))) + 1]); except FileName := ''; end; until (SizeDone = FileSize) or FCancelled or PrivateCancel or (FileName = ''); if FCancelled and (not PrivateCancel) then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; end; if not (FCancelled or PrivateCancel) then begin repeat AEngine.GetFileSystemInfo(FilePath, x, TDF, xx); if (TDF < 512) and (not NewDiskQuestion) then Break; until (TDF >= 512) or PrivateCancel or FCancelled; if WriteCRCFile(DialogsParentWindow, AEngine, IncludeTrailingPathDelimiter(FilePath) + FileName, OriginalFName, SizeDone, FileCRC) then ShowMessageBox(Format(LANGSplitOfSSucceeded, [StrToUTF8(OriginalFName)]), [mbOK], mbInfo, mbNone, mbOK) else begin FCancelMessage := Format(LANGSplitOfSFailed, [StrToUTF8(OriginalFName)]); FShowCancelMessage := True; end; end; // * TODO: set real error, also free it AEngine.CloseFile(FD, nil); if List.Count > 0 then for i := List.Count - 1 downto 0 do FreeDataItem(PDataItem(List[i])); List.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.ChmodFilesWorker; var SkipAll: boolean; function HandleChmod(AFileRec: PDataItemSL): boolean; var Response: integer; Res: boolean; Error: PGError; begin Result := True; // DebugMsg(['Chmod Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); if AFileRec^.DataItem^.IsDir and (ChmodRecurseType >= 0) and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk) then Exit; if (not AFileRec^.DataItem^.IsDir) and (ChmodRecurseType >= 0) and (ChmodRecurseType = 1) then Exit; // Directories only if AFileRec^.DataItem^.IsDir and (ChmodRecurseType >= 0) and (ChmodRecurseType = 2) then Exit; // Files only // * TODO: check error Error := nil; Res := AEngine.Chmod(String(AFileRec^.DataItem^.FName), ChmodMode, @Error); // DebugMsg(['Result : ', Res]); if not Res then if SkipAll then Result := True else begin // * TODO: check error Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, 'Error changing permissions', String(AFileRec^.DataItem^.FDisplayName), Error); if Error <> nil then g_error_free(Error); case Response of DIR_DELETE_SKIP : Result := True; DIR_DELETE_SKIP_ALL : begin SkipAll := True; Result := True; end; DIR_DELETE_RETRY : Result := HandleChmod(AFileRec); else Result := False; end; end; end; var i: longint; AList: TList; Fr: Single; begin SkipAll := False; AList := TList.Create; PrepareJobFilesFromPanel(AList, ChmodRecurseType < 0); libc_chdir('/'); SetProgress1Params(AList.Count); UpdateProgress1(0, '0 %'); CommitGUIUpdate; // DebugWriteListSL(AList); if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); if AList.Count > 0 then for i := 0 to AList.Count - 1 do begin if FCancelled then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; Break; end; // Process chmod if not HandleChmod(AList[i]) then Break; UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); CommitGUIUpdate; end; // Free the objects if AList.Count > 0 then for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.ChownFilesWorker; var SkipAll: boolean; function HandleChown(AFileRec: PDataItemSL): boolean; var Response: integer; Res: boolean; Error: PGError; begin Result := True; // DebugMsg(['Chown Debug: IsDir: ', AFileRec^.IsDir, ', Stage1: ', AFileRec^.Stage1, ', IsLnk: ', AFileRec^.IsLnk, '; Result = ', AFileRec^.IsDir and AFileRec^.Stage1 and (not AFileRec^.IsLnk)]); if (AFileRec^.DataItem^.IsDir and ChownRecursive and AFileRec^.Stage1 and (not AFileRec^.DataItem^.IsLnk)) or ((not AFileRec^.DataItem^.IsDir) and ChownRecursive) then Exit; // * TODO: check error Error := nil; Res := AEngine.Chown(String(AFileRec^.DataItem^.FName), ChownUID, ChownGID, @Error); // DebugMsg(['Result : ', Res]); if not Res then if SkipAll then Result := True else begin // * TODO: check error Response := ShowDirDeleteDialog(DIR_DELETE_SET_DELETE_ERROR, 'Error changing owner', String(AFileRec^.DataItem^.FDisplayName), Error); if Error <> nil then g_error_free(Error); case Response of DIR_DELETE_SKIP : Result := True; DIR_DELETE_SKIP_ALL : begin SkipAll := True; Result := True; end; DIR_DELETE_RETRY : Result := HandleChown(AFileRec); else Result := False; end; end; end; var i: longint; AList: TList; Fr: Single; begin SkipAll := False; AList := TList.Create; PrepareJobFilesFromPanel(AList, not ChownRecursive); libc_chdir('/'); SetProgress1Params(AList.Count); UpdateProgress1(0, '0 %'); CommitGUIUpdate; // DebugWriteListSL(AList); if AList.Count = 1 then Fr := 1 else Fr := 100 / (AList.Count - 1); if AList.Count > 0 then for i := 0 to AList.Count - 1 do begin if FCancelled then begin FCancelMessage := LANGUserCancelled; FShowCancelMessage := True; Break; end; // Process chmod if not HandleChown(AList[i]) then Break; UpdateProgress1(i, Format('%d%%', [Round(Fr * i)])); UpdateCaption1(PDataItemSL(AList[i])^.DataItem^.FDisplayName); CommitGUIUpdate; end; // Free the objects if AList.Count > 0 then for i := AList.Count - 1 downto 0 do FreeDataItem(PDataItemSL(AList[i])); AList.Clear; AList.Free; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TWorkerThread.DummyThreadWorker; var i: integer; begin DebugMsg(['(II) DummyThreadWorker: begin']); SetProgress1Params(100); SetProgress2Params(100); UpdateProgress1(0, '0 %'); UpdateProgress2(100, '100 %'); CommitGUIUpdate; for i := 1 to 100 do begin Sleep(100); DebugMsg([' (II) DummyThreadWorker: done ', i, ' / 100']); UpdateProgress1(i, Format('%d%%', [i])); UpdateCaption1(Format('Test %d test', [i])); UpdateProgress2(101-i, Format('%d%%', [101-i])); UpdateCaption2(Format('Test %d test', [101-i])); CommitGUIUpdate; if FCancelled then Break; end; DebugMsg(['(II) DummyThreadWorker: finish']); end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TOpenDirThread.Create; begin inherited Create(True); FreeOnTerminate := False; ChDirResult := False; ListingResult := False; VFSOpenResult := False; ChDirError := nil; ListingError := nil; VFSOpenError := nil; RunningTime := 0; end; destructor TOpenDirThread.Destroy; begin if VFSOpenError <> nil then g_error_free(VFSOpenError); if ChDirError <> nil then g_error_free(ChDirError); if ListingError <> nil then g_error_free(ListingError); inherited Destroy; end; (********************************************************************************************************************************) function TOpenDirThread.ChangeDir(Engine: TPanelEngine; Path: string; var SelItem: string; const AutoFallBack: boolean): boolean; 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; begin Result := False; 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 repeat if Engine is TVFSEngine then Result := (Engine as TVFSEngine).ChangeDirEx(APath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self, @ChDirError) else Result := Engine.ChangeDir(APath, @ChDirError); if not Result then GoUp(APath); until Result or (not AutoFallback) or (Length(APath) <= 1); if Result then Engine.Path := APath; except on E: Exception do begin Result := False; DebugMsg(['*** Exception raised in UCore.ChangeDir (', E.ClassName, '): ', E.Message]); end; end; end; procedure TOpenDirThread.Execute; var tt: TDateTime; xEngine: TVFSEngine; begin PrepareExecute; try tt := Now; try if APlugin <> nil then begin xEngine := TVFSEngine.Create(APlugin); xEngine.ParentEngine := AEngine; AEngine.LastHighlightItem := AHighlightItem; xEngine.SavePath := AEngine.Path; // AEngine must be set here since VFSOpenEx callbacks will reference it AEngine := xEngine; VFSOpenResult := (AEngine as TVFSEngine).VFSOpenEx(AFullPath, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self, @VFSOpenError); end else VFSOpenResult := True; if VFSOpenResult and (not FCancelled) then begin ChDirResult := ChangeDir(AEngine, APath, ASelItem, AAutoFallBack); if ChDirResult and (not FCancelled) then ListingResult := AEngine.GetListing(ADirList, AEngine.GetPath, ConfShowDotFiles, True, False, @ListingError); end; except on E: Exception do DebugMsg(['*** Exception raised in TOpenDirThread.Execute (', E.ClassName, '): ', E.Message]); end; RunningTime := MilliSecondsBetween(tt, Now); finally FFinished := True; end; end; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TOpenConnectionThread.Create; begin inherited Create(True); FreeOnTerminate := False; OpenResult := False; OpenError := nil; end; destructor TOpenConnectionThread.Destroy; begin inherited Destroy; end; procedure TOpenConnectionThread.Execute; begin PrepareExecute; try OpenResult := (AEngine as TVFSEngine).VFSOpenURI(URI, @vfs_ask_question_callback, @vfs_ask_password_callback, nil, Self, @OpenError); finally FFinished := True; end; end; end.