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 must first impersonate the user and then run the application. I wrote a blog article using impersonation that will probably help you. You need user credentials for that purpose.

Impersonation will make your program (Here a service) act as another user. The blog article use that feature to hide data from current user. In your case, your service will first impersonate as the target user and then launch the application which in turn will run in the context of the impersonated user.

I published the source code on github. This code is the result of a StackOverflow discussion.

Answer 2

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.