Execute app from service in current user session

Question

Using Delphi 10.2.3, I'm implementing a service that, among other things, will need to shut down a user app before a database restore and then restart the app after. Shutting down the app is no problem, but starting the app back up is, for the obvious session-0 reason. I found the following code online to do this, and it works fine, with one exception.

function CreateEnvironmentBlock(var lpEnvironment: Pointer; hToken: THandle; bInherit: BOOL): BOOL; stdcall; external 'userenv.dll';
function DestroyEnvironmentBlock(lpEnvironment: Pointer): BOOL; stdcall; external 'userenv.dll';

function SvcLaunchAppInCurrUserSession(const AppToLaunch: String;
                                       const Params: String = '';
                                       WaitForIt: Boolean = False;
                                       HideIt: Boolean = False): Cardinal;
var
  PI: PROCESS_INFORMATION;
  SI: STARTUPINFO;
  bResult: Boolean;
  dwSessionId: DWORD;
  hUserTokenDup, hPToken: THANDLE;
  dwCreationFlags: DWORD;
  CommandLine: string;
  Directory: string;
  tp: TOKEN_PRIVILEGES;
  pEnv: Pointer;
begin
  Result := S_OK;
  try
    try
      pEnv := nil;
      dwCreationFlags := NORMAL_PRIORITY_CLASS or CREATE_NEW_CONSOLE;
      CommandLine := Trim('"'+Trim(AppToLaunch)+'" '+Params);
      Directory := ExtractFileDir(AppToLaunch);

      // get the current active session and the token
      dwSessionId := WtsGetActiveConsoleSessionID;

      // initialize startup info
      ZeroMemory(@SI, SizeOf(SI));
      SI.cb := SizeOf(STARTUPINFO);
      SI.lpDesktop := nil; //PChar('winsta0\Default');
      SI.dwFlags := STARTF_USESHOWWINDOW;
      if HideIt then
        SI.wShowWindow := SW_HIDE
      else
        SI.wShowWindow := SW_SHOWNORMAL;

      if OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or
                                             TOKEN_QUERY or
                                             TOKEN_DUPLICATE or
                                             TOKEN_ASSIGN_PRIMARY or
                                             TOKEN_ADJUST_SESSIONID or
                                             TOKEN_READ or
                                             TOKEN_WRITE,
                                             hPToken) then begin
        tp.PrivilegeCount := 1;
        tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;

        if LookupPrivilegeValue(nil, 'SeDebugPrivilege', tp.Privileges[0].Luid) then begin
          DuplicateTokenEx(hPToken, MAXIMUM_ALLOWED, nil, SecurityIdentification, TokenPrimary, hUserTokenDup);
          SetTokenInformation(hUserTokenDup, TokenSessionId, @dwSessionId, SizeOf(DWORD));

          if CreateEnvironmentBlock(pEnv, hUserTokenDup, True) then 
            dwCreationFlags := dwCreationFlags or CREATE_UNICODE_ENVIRONMENT
          else
            pEnv := nil;

          // Launch the process in the client's logon session.
          bResult := CreateProcessAsUser(hUserTokenDup,      // client's access token
                                         nil,                // file to execute
                                         PChar(CommandLine), // command line
                                         nil,                // pointer to process SECURITY_ATTRIBUTES
                                         nil,                // pointer to thread SECURITY_ATTRIBUTES
                                         False,              // handles are not inheritable
                                         dwCreationFlags,    // creation flags
                                         pEnv,               // pointer to new environment block
                                         PChar(Directory),   // name of current directory
                                         si,                 // pointer to STARTUPINFO structure
                                         pi);                // receives information about new process

          if not bResult then begin
            Result := GetLastError;
            Exit;
          end;
        end
        else begin
          Result := GetLastError;
          Exit;
        end;
      end
      else begin
        Result := GetLastError;
        Exit;
      end;

      if WaitForIt then begin
        WaitForSingleObject(PI.hProcess, INFINITE);
        GetExitCodeProcess(PI.hProcess, Result);
      end;
    finally
      // close all handles
      if Assigned(pEnv) then
        DestroyEnvironmentBlock(pEnv);
      CloseHandle(hUserTokenDup);
      CloseHandle(PI.hProcess);
      CloseHandle(PI.hThread);
      CloseHandle(hPToken);
    end;
  except
    on E:Exception do begin
      DbgLogFmt('SvcLaunchApp %s: %s', [E.ClassName, E.Message]);
      raise;
    end;
  end;
end;

The problem with this is that it launches the app with the service's permissions (SYSTEM), which is a huge security hole. I want it to launch the app with the current user's permissions, either user or admin, but not system. I know zilch about the ins and outs of Windows security, but I'm sure there's a way to do this - I just don't know what parts of the above need to be tweaked so the right permissions are used. Or if there's a better way to do this, I'm open to it. Suggestions?

Thanks.

Answer 1

You are using the user token that your service is running as (SYSTEM). Use WTSQueryUserToken() to get the user token of the target session instead.