From a0d0f1d73544097a9e9e0b0bc4299f3f171ef72b Mon Sep 17 00:00:00 2001 From: Pavel <68122101+red-prig@users.noreply.github.com> Date: Mon, 19 Feb 2024 10:29:11 +0300 Subject: [PATCH] + --- fpPS4.lpi | 4 ++ gui/game_edit.pas | 47 +++++++++------- gui/game_info.pas | 41 +++++++++++++- gui/game_run.pas | 52 ++++++++++++------ gui/main.pas | 110 +++++++++++++++++++++---------------- sys/kern/kern_exit.pas | 3 + sys/kern/kern_sig.pas | 1 - sys/kern/kern_thread.pas | 49 +++++++++++++++++ sys/md/md_game_process.pas | 59 ++++++++++++++++++++ sys/md/md_systm.pas | 50 ++++++++++------- sys/md/md_thread.pas | 31 +++++++++++ 11 files changed, 341 insertions(+), 106 deletions(-) create mode 100644 sys/md/md_game_process.pas diff --git a/fpPS4.lpi b/fpPS4.lpi index 1fe6b3da..8ef5fd66 100644 --- a/fpPS4.lpi +++ b/fpPS4.lpi @@ -854,6 +854,10 @@ + + + + diff --git a/gui/game_edit.pas b/gui/game_edit.pas index 9ac3451a..624c4923 100644 --- a/gui/game_edit.pas +++ b/gui/game_edit.pas @@ -34,6 +34,11 @@ type procedure GridSelectEditor(Sender:TObject;aCol,aRow:Integer;var Editor:TWinControl); procedure GridEditingDone(Sender: TObject); private + Fapp0_row :Integer; + FName_row :Integer; + FTitleId_row:Integer; + FVersion_row:Integer; + Fapp0p:RawByteString; public OnSave :TNotifyEvent; @@ -227,6 +232,13 @@ begin begin For i:=0 to c-1 do begin + case A[i].Name of + 'Name' :FName_row :=GridMain.RowCount; + 'TitleId':FTitleId_row:=GridMain.RowCount; + 'Version':FVersion_row:=GridMain.RowCount; + else; + end; + AddRow(GridMain,A[i].Name+':',A[i].GetValue(Item.FGameInfo).AsString,nil); end; end; @@ -238,6 +250,11 @@ begin begin For i:=0 to c-1 do begin + case A[i].Name of + 'app0':Fapp0_row:=GridMounts.RowCount; + else; + end; + AddRow(GridMounts,'/'+A[i].Name,A[i].GetValue(Item.FMountList).AsString,fip); end; end; @@ -246,10 +263,6 @@ begin Ctx.free; end; - //AddRow(GridMounts,'/app0' ,ip); - //AddRow(GridMounts,'/system',ip); - //AddRow(GridMounts,'/data' ,ip); - LoadParamSfo(UpdateTitle); Show; @@ -294,25 +307,19 @@ begin end; end; -function GetGridVal(Grid:TStringGrid;const name:RawByteString):RawByteString; -var - i:Integer; +function GetGridVal(Grid:TStringGrid;ARow:Integer):RawByteString; begin Result:=''; - i:=Grid.Cols[0].IndexOf(name); - if (i=-1) then Exit; + if (ARow<0) and (ARow>=Grid.RowCount) then Exit; // - Result:=Grid.Cells[1,i]; + Result:=Grid.Cells[1,ARow]; end; -procedure SetGridVal(Grid:TStringGrid;const name,value:RawByteString); -var - i:Integer; +procedure SetGridVal(Grid:TStringGrid;ARow:Integer;const value:RawByteString); begin - i:=Grid.Cols[0].IndexOf(name); - if (i=-1) then Exit; + if (ARow<0) and (ARow>=Grid.RowCount) then Exit; // - Grid.Cells[1,i]:=value; + Grid.Cells[1,ARow]:=value; end; procedure TfrmGameEditor.LoadParamSfo(UpdateTitle:Boolean); @@ -320,7 +327,7 @@ var i:Integer; V:RawByteString; begin - V:=GetGridVal(GridMounts,'/app0'); + V:=GetGridVal(GridMounts,Fapp0_row); if (Fapp0p=V) then Exit; @@ -357,13 +364,13 @@ begin if not UpdateTitle then Exit; V:=ParamSfo.GetString('TITLE'); - SetGridVal(GridMain,'Name:',V); + SetGridVal(GridMain,FName_row,V); V:=ParamSfo.GetString('TITLE_ID'); - SetGridVal(GridMain,'TitleId:',V); + SetGridVal(GridMain,FTitleId_row,V); V:=ParamSfo.GetString('VERSION'); - SetGridVal(GridMain,'Version:',V); + SetGridVal(GridMain,FVersion_row,V); end; procedure TfrmGameEditor.GridSelectEditor(Sender:TObject;aCol,aRow:Integer;var Editor:TWinControl); diff --git a/gui/game_info.pas b/gui/game_info.pas index 6da7ba39..bff4aad9 100644 --- a/gui/game_info.pas +++ b/gui/game_info.pas @@ -7,7 +7,8 @@ interface uses Classes, SysUtils, - IniFiles; + IniFiles, + host_ipc; type TAbstractInfo=class @@ -69,11 +70,49 @@ type Procedure Deserialize(Stream:TStream); override; end; + TGameProcess=class + g_ipc :THostIpcConnect; + g_proc :THandle; + g_p_pid:Integer; + g_fork :Boolean; + function is_terminated:Boolean; virtual; + procedure suspend; virtual; + procedure resume; virtual; + procedure stop; virtual; + Destructor Destroy; override; + end; + implementation uses TypInfo,Rtti; +function TGameProcess.is_terminated:Boolean; +begin + Result:=False; +end; + +procedure TGameProcess.suspend; +begin + // +end; + +procedure TGameProcess.resume; +begin + // +end; + +procedure TGameProcess.stop; +begin + // +end; + +Destructor TGameProcess.Destroy; +begin + FreeAndNil(g_ipc); + inherited; +end; + Procedure TAbstractInfo.Serialize(Stream:TStream); var i,c:Integer; diff --git a/gui/game_run.pas b/gui/game_run.pas index 3f307af4..efe6c6fb 100644 --- a/gui/game_run.pas +++ b/gui/game_run.pas @@ -23,22 +23,14 @@ type fork_proc:Boolean; end; - TGameProcess=class - g_ipc :THostIpcConnect; - g_fork:Boolean; - end; - TGameProcessSimple=class(TGameProcess) Ftd:p_kthread; - end; - - TGameProcessPipe=class(TGameProcess) - FProcess:THandle; - FChild:THandle; + procedure suspend; override; + procedure resume; override; + Destructor Destroy; override; end; var - kern_ipc:THostIpcConnect=nil; function run_item(const cfg:TGameRunConfig;Item:TGameItem):TGameProcess; @@ -60,6 +52,8 @@ uses kern_proc, md_systm, + md_game_process, + //internal libs ps4_libSceSystemService, ps4_libSceUserService, @@ -70,6 +64,24 @@ uses ; +// + +procedure TGameProcessSimple.suspend; +begin + thread_suspend_all(Ftd); +end; + +procedure TGameProcessSimple.resume; +begin + thread_resume_all(Ftd); +end; + +Destructor TGameProcessSimple.Destroy; +begin + thread_dec_ref(Ftd); + inherited; +end; + var runing:Boolean=False; @@ -252,7 +264,7 @@ begin p_mgui_ipc.set_pipe(kern2mgui[0]); g_ipc:=p_mgui_ipc; - FChild:=kern2mgui[1]; + FChildpip:=kern2mgui[1]; end; // @@ -263,12 +275,15 @@ begin Item.Serialize(mem); - r:=md_fork_process(@fork_process,mem.Memory,mem.Size,fork_info); + fork_info.hInput :=GetStdHandle(STD_INPUT_HANDLE); + fork_info.hOutput:=cfg.hOutput; + fork_info.hError :=cfg.hError; - with TGameProcessPipe(Result) do - begin - FProcess:=fork_info.hProcess; - end; + fork_info.proc:=@fork_process; + fork_info.data:=mem.Memory; + fork_info.size:=mem.Size; + + r:=md_fork_process(fork_info); mem.Free; end else @@ -297,6 +312,9 @@ begin end; + Result.g_proc :=fork_info.hProcess; + Result.g_p_pid:=fork_info.fork_pid; + Result.g_ipc.thread_new; kev.ident :=fork_info.fork_pid; diff --git a/gui/main.pas b/gui/main.pas index ef036fc7..a899589c 100644 --- a/gui/main.pas +++ b/gui/main.pas @@ -7,6 +7,15 @@ interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, Grids, Menus, + g_bufstream, + LineStream, + synlog, + SynEditLineStream, + LazSynEditText, + SynEditMarkupBracket, + + IniFiles, + game_info, game_edit, game_run, @@ -42,7 +51,21 @@ type private public - GameProcess:TGameProcess; + FGameProcess:TGameProcess; + + FIniFile:TIniFile; + + FMainInfo:TMainInfo; + + FAddHandle:THandle; + FGetHandle:THandle; + + FFile:TStream; + FList:TSynEditLineStream; + + Fmlog:TCustomSynLog; + + FLogUpdateTime:QWORD; procedure ReadIniFile; procedure LoadItemIni(Item:TGameItem); @@ -54,6 +77,8 @@ type procedure DelItemRow(Item:TGameItem); procedure DoAdd(Sender: TObject); procedure DoEdit(Sender: TObject); + procedure LogEnd; + procedure ClearLog; end; var @@ -66,15 +91,6 @@ uses md_arc4random, - g_bufstream, - LineStream, - synlog, - SynEditLineStream, - LazSynEditText, - SynEditMarkupBracket, - - IniFiles, - TypInfo, Rtti, @@ -82,39 +98,33 @@ uses // -var - FIniFile:TIniFile; - - FMainInfo:TMainInfo; - - FAddHandle:THandle; - FGetHandle:THandle; - - FFile:TStream; - FList:TSynEditLineStream; - {$R *.lfm} { TfrmMain } type TMySynLog=class(TCustomSynLog) - function LinesCreate:TSynEditStringListBase; override; + Form:TfrmMain; + constructor Create(AOwner: TComponent; AForm:TfrmMain); + function LinesCreate:TSynEditStringListBase; override; end; +constructor TMySynLog.Create(AOwner: TComponent; AForm:TfrmMain); +begin + Form:=AForm; + inherited Create(AOwner); +end; + function TMySynLog.LinesCreate:TSynEditStringListBase; begin - FList:=TSynEditLineStream.Create; + Form.FList:=TSynEditLineStream.Create; - FList.FSynLog:=Self; - FList.FStream:=TLineStream.Create(FFile); + Form.FList.FSynLog:=Self; + Form.FList.FStream:=TLineStream.Create(Form.FFile); - Result:=FList; + Result:=Form.FList; end; -var - mlog:TMySynLog; - const section_prefix='game-'; @@ -301,22 +311,19 @@ begin FFile:=TBufferedFileStream.Create(FGetHandle); - mlog:=TMySynLog.Create(TabLog); - mlog.Parent:=TabLog; + Fmlog:=TMySynLog.Create(TabLog,Self); + Fmlog.Parent:=TabLog; - mlog.Align:=alClient; + Fmlog.Align:=alClient; - mlog.BracketHighlightStyle:=sbhsBoth; - mlog.Font.Style:=[]; + Fmlog.BracketHighlightStyle:=sbhsBoth; + Fmlog.Font.Style:=[]; Pages.ActivePageIndex:=0; Application.AddOnIdleHandler(@OnIdleUpdate,False); end; -Var - FLogUpdateTime:QWORD=0; - procedure TfrmMain.OnIdleUpdate(Sender:TObject;var Done:Boolean); begin Done:=True; @@ -330,10 +337,10 @@ begin FLogUpdateTime:=GetTickCount64; end; - if (GameProcess<>nil) then - if (GameProcess.g_ipc<>nil) then + if (FGameProcess<>nil) then + if (FGameProcess.g_ipc<>nil) then begin - GameProcess.g_ipc.Update(IpcHandler); + FGameProcess.g_ipc.Update(IpcHandler); end; end; @@ -404,6 +411,19 @@ begin form.FormInit(False); end; +procedure TfrmMain.LogEnd; +begin + Fmlog.TopLine:=Fmlog.Lines.Count; +end; + +procedure TfrmMain.ClearLog; +begin + //reset file + FileTruncate(FAddHandle,0); + FList.Reset; + // +end; + procedure TfrmMain.MIRunClick(Sender: TObject); var Item:TGameItem; @@ -417,12 +437,8 @@ begin Item:=GetItemRow(aRow); - FList.FSynLog.TopLine:=FList.FSynLog.Lines.Count; - - //reset file - FileTruncate(FAddHandle,0); - FList.Reset; - // + LogEnd; + ClearLog; Pages.ActivePage:=TabLog; @@ -431,7 +447,7 @@ begin cfg.fork_proc:=True; - GameProcess:=run_item(cfg,Item); + FGameProcess:=run_item(cfg,Item); end; procedure TfrmMain.MIDelClick(Sender: TObject); diff --git a/sys/kern/kern_exit.pas b/sys/kern/kern_exit.pas index fdb383fb..97fc2142 100644 --- a/sys/kern/kern_exit.pas +++ b/sys/kern/kern_exit.pas @@ -128,6 +128,8 @@ begin Result:=(ret shl 8) or sig; end; +procedure thread_suspend_all(exclude:Pointer); external; + procedure exit1(rv:Integer); begin //Notify interested parties of our demise. @@ -138,6 +140,7 @@ begin md_halt(rv); end else begin + thread_suspend_all(nil); msleep_td(0); end; end; diff --git a/sys/kern/kern_sig.pas b/sys/kern/kern_sig.pas index 457cff57..dc95fcb8 100644 --- a/sys/kern/kern_sig.pas +++ b/sys/kern/kern_sig.pas @@ -127,7 +127,6 @@ uses kern_prot, kern_synch, md_context, - md_proc, machdep, sched_ule, sys_sleepqueue; diff --git a/sys/kern/kern_thread.pas b/sys/kern/kern_thread.pas index aac5f3e3..465a370b 100644 --- a/sys/kern/kern_thread.pas +++ b/sys/kern/kern_thread.pas @@ -56,6 +56,9 @@ procedure threadinit; //SYSINIT function kthread_add (func,arg:Pointer;newtdp:pp_kthread;name:PChar):Integer; procedure kthread_exit(); +procedure thread_suspend_all(exclude:p_kthread); +procedure thread_resume_all (exclude:p_kthread); + var init_tty_cb:Tprocedure; @@ -815,6 +818,52 @@ begin // NOTREACHED end; +procedure thread_suspend_all(exclude:p_kthread); public; +var + td,ttd:p_kthread; +begin + td:=curkthread; + + threads_lock; + + ttd:=TAILQ_FIRST(@p_threads); + while (ttd<>nil) do + begin + + if (ttd<>td) and (ttd<>exclude) then + begin + md_suspend(ttd); + end; + + ttd:=TAILQ_NEXT(ttd,@ttd^.td_plist) + end; + + threads_unlock; +end; + +procedure thread_resume_all(exclude:p_kthread); public; +var + td,ttd:p_kthread; +begin + td:=curkthread; + + threads_lock; + + ttd:=TAILQ_FIRST(@p_threads); + while (ttd<>nil) do + begin + + if (ttd<>td) and (ttd<>exclude) then + begin + md_resume(ttd); + end; + + ttd:=TAILQ_NEXT(ttd,@ttd^.td_plist) + end; + + threads_unlock; +end; + function sys_thr_kill(id,sig:Integer):Integer; var td,ttd:p_kthread; diff --git a/sys/md/md_game_process.pas b/sys/md/md_game_process.pas new file mode 100644 index 00000000..f1a145e5 --- /dev/null +++ b/sys/md/md_game_process.pas @@ -0,0 +1,59 @@ +unit md_game_process; + +{$mode ObjFPC}{$H+} + +interface + +uses + windows, + ntapi, + game_info; + +type + TGameProcessPipe=class(TGameProcess) + FChildpip:THandle; + function is_terminated:Boolean; override; + procedure suspend; override; + procedure resume; override; + procedure stop; override; + Destructor Destroy; override; + end; + +implementation + +function TGameProcessPipe.is_terminated:Boolean; +var + R:DWORD; + T:QWORD; +begin + T:=0; + R:=NtWaitForSingleObject(g_proc,False,@T); + + Result:=(R=STATUS_WAIT_0); +end; + +procedure TGameProcessPipe.suspend; +begin + NtSuspendProcess(g_proc); +end; + +procedure TGameProcessPipe.resume; +begin + NtResumeProcess(g_proc); +end; + +procedure TGameProcessPipe.stop; +begin + NtTerminateProcess(g_proc,0); +end; + +Destructor TGameProcessPipe.Destroy; +begin + CloseHandle(g_proc); + CloseHandle(FChildpip); + inherited; +end; + + +end. + diff --git a/sys/md/md_systm.pas b/sys/md/md_systm.pas index cd59b021..2d835b59 100644 --- a/sys/md/md_systm.pas +++ b/sys/md/md_systm.pas @@ -15,8 +15,16 @@ type p_fork_proc=^t_fork_proc; t_fork_proc=record - hProcess:THandle; - fork_pid:Integer; + hInput :THandle; //in + hOutput:THandle; //in + hError :THandle; //in + + proc:Pointer; //in + data:Pointer; //in + size:QWORD; //in + + hProcess:THandle; //out + fork_pid:Integer; //out end; function md_copyin (hProcess:THandle;udaddr,kaddr:Pointer;len:ptruint;lencopied:pptruint):Integer; @@ -31,7 +39,7 @@ function md_pidfd_open (pid:DWORD):THandle; procedure md_run_forked; procedure md_fork_unshare; -function md_fork_process(proc:Pointer;data:Pointer;size:QWORD;var info:t_fork_proc):Integer; +function md_fork_process(var info:t_fork_proc):Integer; implementation @@ -435,7 +443,7 @@ begin Exit(hProcJob); end; -function NtCreateShared(hProcess:THandle;proc:Pointer;data:Pointer;size:QWORD):Integer; +function NtCreateShared(hProcess:THandle;var info:t_fork_proc):Integer; var base:p_shared_info; full:QWORD; @@ -443,8 +451,8 @@ var begin base:=Pointer(WIN_SHARED_ADDR); - full:=SizeOf(shared_info)+size; - full:=(size+(MD_PAGE_SIZE-1)) and (not (MD_PAGE_SIZE-1)); + full:=SizeOf(shared_info)+info.size; + full:=(info.size+(MD_PAGE_SIZE-1)) and (not (MD_PAGE_SIZE-1)); Result:=md_mmap(hProcess,base,full,MD_PROT_RW); if (Result<>0) then Exit; @@ -453,36 +461,38 @@ begin shared_info.ppid :=GetCurrentProcessId; - shared_info.hStdInput :=md_dup_to_pidfd(hProcess,GetStdHandle(STD_INPUT_HANDLE)); - shared_info.hStdOutput:=md_dup_to_pidfd(hProcess,GetStdHandle(STD_OUTPUT_HANDLE)); - shared_info.hStdError :=md_dup_to_pidfd(hProcess,GetStdHandle(STD_ERROR_HANDLE)); + shared_info.hStdInput :=md_dup_to_pidfd(hProcess,info.hInput ); + shared_info.hStdOutput:=md_dup_to_pidfd(hProcess,info.hOutput); + shared_info.hStdError :=md_dup_to_pidfd(hProcess,info.hError ); - shared_info.proc:=proc; - shared_info.size:=size; + shared_info.proc:=info.proc; + shared_info.size:=info.size; Result:=md_copyout(hProcess,@shared_info,base,SizeOf(shared_info),nil); if (Result<>0) then Exit; - if (data<>nil) and (size<>0) then + if (info.data<>nil) and (info.size<>0) then begin - Result:=md_copyout(hProcess,data,@base^.data,size,nil); + Result:=md_copyout(hProcess,info.data,@base^.data,info.size,nil); end; end; -function md_fork_process(proc:Pointer;data:Pointer;size:QWORD;var info:t_fork_proc):Integer; -var - si:TSTARTUPINFO; - pi:PROCESS_INFORMATION; - BUF:packed record +function md_fork_process(var info:t_fork_proc):Integer; +type + TBUF_PROC_INFO=packed record UNAME:UNICODE_STRING; DATA :array[0..MAX_PATH*2] of WideChar; end; +var + si:TSTARTUPINFO; + pi:PROCESS_INFORMATION; + BUF:TBUF_PROC_INFO; LEN:ULONG; b:BOOL; begin Result:=0; - FillChar(BUF,SizeOf(BUF),0); + BUF:=Default(TBUF_PROC_INFO); LEN:=SizeOf(BUF); Result:=NtQueryInformationProcess(NtCurrentProcess, @@ -509,7 +519,7 @@ begin Result:=NtReserve(pi.hProcess); if (Result<>0) then Exit; - Result:=NtCreateShared(pi.hProcess,proc,data,size); + Result:=NtCreateShared(pi.hProcess,info); if (Result<>0) then Exit; Result:=NtResumeProcess(pi.hProcess); diff --git a/sys/md/md_thread.pas b/sys/md/md_thread.pas index b50fea52..0436ccb3 100644 --- a/sys/md/md_thread.pas +++ b/sys/md/md_thread.pas @@ -35,6 +35,9 @@ function cpu_set_priority(td:p_kthread;prio:Integer):Integer; function cpu_thread_set_name(td:p_kthread;const name:shortstring):Integer; +function md_suspend(td:p_kthread):Integer; +function md_resume (td:p_kthread):Integer; + procedure seh_wrapper_before(td:p_kthread;var func:Pointer); procedure seh_wrapper_after (td:p_kthread;func:Pointer); @@ -344,6 +347,34 @@ begin Result:=NtSetInformationThread(td^.td_handle,ThreadNameInformation,@UNAME,SizeOf(UNAME)); end; +function md_suspend(td:p_kthread):Integer; +var + count:ULONG; +begin + Result:=0; + if (td=nil) then Exit; + if (td^.td_handle=0) or (td^.td_handle=THandle(-1)) then Exit; + + count:=0; + NtSuspendThread(td^.td_handle,@count); + + Result:=count; +end; + +function md_resume(td:p_kthread):Integer; +var + count:ULONG; +begin + Result:=0; + if (td=nil) then Exit; + if (td^.td_handle=0) or (td^.td_handle=THandle(-1)) then Exit; + + count:=0; + NtResumeThread(td^.td_handle,@count); + + Result:=count; +end; + procedure main_wrapper; assembler; nostackframe; asm subq $40, %rsp