{ ************************************************************** Package: XWB - Kernel RPCBroker Date Created: Sept 18, 1997 (Version 1.1) Site Name: Oakland, OI Field Office, Dept of Veteran Affairs Developers: Danila Manapsal, Don Craven, Joel Ivey Description: Contains TRPCBroker and related components. Current Release: Version 1.1 Patch 40 (January 7, 2005) *************************************************************** } {************************************************** This is the hierarchy of things: TRPCBroker contains TParams, which contains array of TParamRecord each of which contains TMult v1.1*4 Silent Login changes (DCM) 10/22/98 1.1*6 Polling to support terminating arphaned server jobs. (P6) == DPC 4/99 1.1*8 Check for Multi-Division users. (P8) - REM 7/13/99 1.1*13 More silent login code; deleted obsolete lines (DCM) 9/10/99 // p13 LAST UPDATED: 5/24/2001 // p13 JLI 1.1*31 Added new read only property BrokerVersion to TRPCBroker which should contain the version number for the RPCBroker (or SharedRPCBroker) in use. **************************************************} unit CCOWRPCBroker; interface {$I IISBase.inc} uses {Delphi standard} Classes, Controls, Dialogs, {DsgnIntf,} Forms, Graphics, Messages, SysUtils, WinProcs, WinTypes, Windows, extctrls, {P6} {VA} XWBut1, {RpcbEdtr,} MFunStr, Hash, ComObj, ActiveX, OleCtrls, trpcb, VERGENCECONTEXTORLib_TLB; const NoMore: boolean = False; MIN_RPCTIMELIMIT: integer = 30; CURRENT_RPC_VERSION: String = 'XWB*1.1*36T1'; type TCCOWRPCBroker = class(TRPCBroker) private protected FCCOWLogonIDName: String; FCCOWLogonIDValue: String; FCCOWLogonName: String; FCCOWLogonNameValue: String; FContextor: TContextorControl; //CCOW FCCOWtoken: string; //CCOW FVistaDomain: String; FCCOWLogonVpid: String; FCCOWLogonVpidValue: String; FWasUserDefined: Boolean; procedure SetConnected(Value: Boolean); override; function GetCCOWHandle(ConnectedBroker: TCCOWRPCBroker): string; procedure CCOWsetUser(Uname, token, Domain, Vpid: string; Contextor: TContextorControl); function GetCCOWduz( Contextor: TContextorControl): string; public function GetCCOWtoken(Contextor: TContextorControl): string; function IsUserCleared: Boolean; function WasUserDefined: Boolean; function IsUserContextPending(aContextItemCollection: IContextItemCollection): Boolean; property Contextor: TContextorControl read Fcontextor write FContextor; //CCOW property CCOWLogonIDName: String read FCCOWLogonIDName; property CCOWLogonIDValue: String read FCCOWLogonIDValue; property CCOWLogonName: String read FCCOWLogonName; property CCOWLogonNameValue: String read FCCOWLogonNameValue; property CCOWLogonVpid: String read FCCOWLogonVpid; property CCOWLogonVpidValue: String read FCCOWLogonVpidValue; published property Connected: boolean read FConnected write SetConnected; end; procedure AuthenticateUser(ConnectingBroker: TCCOWRPCBroker); implementation uses Loginfrm, RpcbErr, WSockc, SelDiv{p8}, RpcSLogin{p13}, fRPCBErrMsg, CCOW_const; var CCOWToken: String; Domain: String; PassCode1: String; PassCode2: String; {--------------------- TCCOWRPCBroker.SetConnected -------------------- ------------------------------------------------------------------} procedure TCCOWRPCBroker.SetConnected(Value: Boolean); var BrokerDir, Str1, Str2, Str3 :string; RPCBContextor: TContextorControl; begin RPCBError := ''; Login.ErrorText := ''; if (Connected <> Value) and not(csReading in ComponentState) then begin if Value and (FConnecting <> Value) then begin {connect} FSocket := ExistingSocket(Self); FConnecting := True; // FConnected := True; try if FSocket = 0 then begin {Execute Client Agent from directory in Registry.} BrokerDir := ReadRegData(HKLM, REG_BROKER, 'BrokerDr'); if BrokerDir <> '' then ProcessExecute(BrokerDir + '\ClAgent.Exe', sw_ShowNoActivate) else ProcessExecute('ClAgent.Exe', sw_ShowNoActivate); if DebugMode and (not OldConnectionOnly) then begin Str1 := 'Control of debugging FOR UCX OR NON-CALLBACK CONNECTIONS has been moved from the client to the server. To start a Debug session, do the following:'+#13#10#13#10; Str2 := '1. On the server, set initial breakpoints where desired.'+#13#10+'2. DO DEBUG^XWBTCPM.'+#13#10+'3. Enter a unique Listener port number (i.e., a port number not in general use).'+#13#10; Str3 := '4. Connect the client application using the port number entered in Step #3.'; ShowMessage(Str1 + Str2 + Str3); end; TXWBWinsock(XWBWinsock).IsBackwardsCompatible := IsBackwardCompatibleConnection; TXWBWinsock(XWBWinsock).OldConnectionOnly := OldConnectionOnly; FSocket := TXWBWinsock(XWBWinsock).NetworkConnect(DebugMode, FServer, ListenerPort, FRPCTimeLimit); AuthenticateUser(Self); StoreConnection(Self); //MUST store connection before CreateContext() //CCOW start if (FContextor <> nil) and (length(CCOWtoken) = 0) then begin //Get new CCOW token CCOWToken := GetCCOWHandle(Self); if Length(CCOWToken) > 0 then begin try RPCBContextor := TContextorControl.Create(Application); RPCBContextor.Run('BrokerLoginModule#', PassCode1+PassCode2, TRUE, '*'); CCOWsetUser(user.name, CCOWToken, Domain, user.Vpid, RPCBContextor); //Clear token FCCOWLogonIDName := CCOW_LOGON_ID; FCCOWLogonIdValue := Domain; FCCOWLogonName := CCOW_LOGON_NAME; FCCOWLogonNameValue := user.name; if user.name <> '' then FWasUserDefined := True; FCCOWLogonVpid := CCOW_LOGON_VPID; FCCOWLogonVpidValue := user.Vpid; RPCBContextor.Free; RPCBContextor := nil; except ShowMessage('Problem with Contextor.Run'); FreeAndNil(RPCBContextor); end; end; // if Length(CCOWToken) > 0 end; //if //CCOW end FPulse.Enabled := True; //P6 Start heartbeat. CreateContext(''); //Closes XUS SIGNON context. end else begin //p13 StoreConnection(Self); FPulse.Enabled := True; //p13 end; //p13 FConnected := True; // jli mod 12/17/01 FConnecting := False; except on E: EBrokerError do begin if E.Code = XWB_BadSignOn then TXWBWinsock(XWBWinsock).NetworkDisconnect(FSocket); FSocket := 0; FConnected := False; FConnecting := False; FRPCBError := E.Message; // p13 handle errors as specified if Login.ErrorText <> '' then FRPCBError := E.Message + chr(10) + Login.ErrorText; if Assigned(FOnRPCBFailure) then // p13 FOnRPCBFailure(Self) // p13 else if ShowErrorMsgs = semRaise then Raise; // p13 // raise; {this is where I would do OnNetError} end{on}; end{try}; end{if} else if not Value then begin //p13 FConnected := False; //p13 FPulse.Enabled := False; //p13 if RemoveConnection(Self) = NoMore then begin {FPulse.Enabled := False; ///P6;p13 } TXWBWinsock(XWBWinsock).NetworkDisconnect(Socket); {actually disconnect from server} FSocket := 0; {store internal} //FConnected := False; //p13 end{if}; end; {else} end{if}; end; function TCCOWRPCBroker.WasUserDefined: Boolean; begin Result := FWasUserDefined; end; function TCCOWRPCBroker.IsUserCleared: Boolean; var CCOWcontextItem: IContextItemCollection; //CCOW CCOWdataItem1: IContextItem; //CCOW Name: String; begin Result := False; Name := CCOW_LOGON_ID; if (Contextor <> nil) then try //See if context contains the ID item CCOWcontextItem := Contextor.CurrentContext; CCOWDataItem1 := CCowContextItem.Present(Name); if (CCOWdataItem1 <> nil) then //1 begin If CCOWdataItem1.Value = '' then Result := True else FWasUserDefined := True; end else Result := True; finally end; //try end; {------------------------ AuthenticateUser ------------------------ ------------------------------------------------------------------} procedure AuthenticateUser(ConnectingBroker: TCCOWRPCBroker); var SaveClearParmeters, SaveClearResults: boolean; SaveParam: TParams; SaveRemoteProcedure, SaveRpcVersion: string; SaveResults: TStrings; blnSignedOn: boolean; SaveKernelLogin: boolean; SaveVistaLogin: TVistaLogin; OldExceptionHandler: TExceptionEvent; OldHandle: THandle; begin With ConnectingBroker do begin SaveParam := TParams.Create(nil); SaveParam.Assign(Param); //save off settings SaveRemoteProcedure := RemoteProcedure; SaveRpcVersion := RpcVersion; SaveResults := Results; SaveClearParmeters := ClearParameters; SaveClearResults := ClearResults; ClearParameters := True; //set'em as I need'em ClearResults := True; SaveKernelLogin := KernelLogin; // p13 SaveVistaLogin := Login; // p13 end; blnSignedOn := False; //initialize to bad sign-on if ConnectingBroker.AccessVerifyCodes <> '' then // p13 handle as AVCode single signon begin ConnectingBroker.Login.AccessCode := Piece(ConnectingBroker.AccessVerifyCodes, ';', 1); ConnectingBroker.Login.VerifyCode := Piece(ConnectingBroker.AccessVerifyCodes, ';', 2); ConnectingBroker.Login.Mode := lmAVCodes; ConnectingBroker.KernelLogIn := False; end; //CCOW start if ConnectingBroker.KernelLogIn and (not (ConnectingBroker.Contextor = nil)) then begin CCOWtoken := ConnectingBroker.GetCCOWtoken(ConnectingBroker.Contextor); if length(CCOWtoken)>0 then begin ConnectingBroker.FKernelLogIn := false; ConnectingBroker.Login.Mode := lmAppHandle; ConnectingBroker.Login.LogInHandle := CCOWtoken; end; end; //CCOW end //CCOW Start // p13 following section for silent signon if not ConnectingBroker.FKernelLogIn then if ConnectingBroker.FLogin <> nil then //the user. vistalogin contains login info begin blnsignedon := SilentLogin(ConnectingBroker); // RpcSLogin unit if not blnSignedOn then begin //Switch back to Kernel Login ConnectingBroker.FKernelLogIn := true; ConnectingBroker.Login.Mode := lmAVCodes; end; end; //CCOW end if ConnectingBroker.FKernelLogIn then begin //p13 if Assigned(Application.OnException) then OldExceptionHandler := Application.OnException else OldExceptionHandler := nil; Application.OnException := TfrmErrMsg.RPCBShowException; frmSignon := TfrmSignon.Create(Application); try // ShowApplicationAndFocusOK(Application); OldHandle := GetForegroundWindow; SetForegroundWindow(frmSignon.Handle); PrepareSignonForm(ConnectingBroker); if SetUpSignOn then //SetUpSignOn in loginfrm unit. begin //True if signon needed if frmSignOn.lblServer.Caption <> '' then begin frmSignOn.ShowModal; //do interactive logon // p13 if frmSignOn.Tag = 1 then //Tag=1 for good logon blnSignedOn := True; //Successfull logon end end else //False when no logon needed blnSignedOn := NoSignOnNeeded; //Returns True always (for now!) if blnSignedOn then //P6 If logged on, retrieve user info. begin GetBrokerInfo(ConnectingBroker); if not SelDiv.ChooseDiv('',ConnectingBroker) then begin blnSignedOn := False;//P8 {Select division if multi-division user. First parameter is 'userid' (DUZ or username) for future use. (P8)} ConnectingBroker.Login.ErrorText := 'Failed to select Division'; // p13 set some text indicating problem end; end; SetForegroundWindow(OldHandle); finally frmSignon.Free; // frmSignon.Release; //get rid of signon form // if ConnectingBroker.Owner is TForm then // SetForegroundWindow(TForm(ConnectingBroker.Owner).Handle) // else // SetForegroundWindow(ActiveWindow); ShowApplicationAndFocusOK(Application); end ; //try if Assigned(OldExceptionHandler) then Application.OnException := OldExceptionHandler; end; //if kernellogin // p13 following section for silent signon if (not ConnectingBroker.KernelLogIn) and (not blnsignedon) then // was doing the signon twice if already true if ConnectingBroker.Login <> nil then //the user. vistalogin contains login info blnsignedon := SilentLogin(ConnectingBroker); // RpcSLogin unit if not blnsignedon then begin // ConnectingBroker.Login.FailedLogin(ConnectingBroker.Login); TXWBWinsock(ConnectingBroker.XWBWinsock).NetworkDisconnect(ConnectingBroker.Socket); end else GetBrokerInfo(ConnectingBroker); //reset the Broker with ConnectingBroker do begin ClearParameters := SaveClearParmeters; ClearResults := SaveClearResults; Param.Assign(SaveParam); //restore settings SaveParam.Free; RemoteProcedure := SaveRemoteProcedure; RpcVersion := SaveRpcVersion; Results := SaveResults; FKernelLogin := SaveKernelLogin; // p13 FLogin := SaveVistaLogin; // p13 end; if not blnSignedOn then //Flag for unsuccessful signon. TXWBWinsock(ConnectingBroker.XWBWinsock).NetError('',XWB_BadSignOn); //Will raise error. end; {----------------------- GetCCOWHandle -------------------------- Private function to return a special CCOW Handle from the server which is set into the CCOW context. The Broker of a new application can get the CCOWHandle from the context and use it to do a ImAPPHandle Sign-on. ----------------------------------------------------------------} function TCCOWRPCBroker.GetCCOWHandle(ConnectedBroker : TCCOWRPCBroker): String; // p13 begin Result := ''; with ConnectedBroker do try // to permit it to work correctly if CCOW is not installed on the server. begin RemoteProcedure := 'XUS GET CCOW TOKEN'; Call; Result := Results[0]; Domain := Results[1]; RemoteProcedure := 'XUS CCOW VAULT PARAM'; Call; PassCode1 := Results[0]; PassCode2 := Results[1]; end; except Result := ''; end; end; //CCOW start procedure TCCOWRPCBroker.CCOWsetUser(Uname, token, Domain, Vpid: string; Contextor: TContextorControl); var CCOWdata: IContextItemCollection; //CCOW CCOWdataItem1,CCOWdataItem2,CCOWdataItem3: IContextItem; CCOWdataItem4,CCOWdataItem5: IContextItem; //CCOW Cname: string; begin if Contextor <> nil then begin try //Part 1 Contextor.StartContextChange; //Part 2 Set the new proposed context data CCOWdata := CoContextItemCollection.Create; CCOWdataItem1 := CoContextItem.Create; Cname := CCOW_LOGON_ID; CCOWdataItem1.Name := Cname; CCOWdataItem1.Value := domain; CCOWData.Add(CCOWdataItem1); CCOWdataItem2 := CoContextItem.Create; Cname := CCOW_LOGON_TOKEN; CCOWdataItem2.Name := Cname; CCOWdataItem2.Value := token; CCOWdata.Add(CCOWdataItem2); CCOWdataItem3 := CoContextItem.Create; Cname := CCOW_LOGON_NAME; CCOWdataItem3.Name := Cname; CCOWdataItem3.Value := Uname; CCOWdata.Add(CCOWdataItem3); // CCOWdataItem4 := CoContextItem.Create; Cname := CCOW_LOGON_VPID; CCOWdataItem4.Name := Cname; CCOWdataItem4.Value := Vpid; CCOWdata.Add(CCOWdataItem4); // CCOWdataItem5 := CoContextItem.Create; Cname := CCOW_USER_NAME; CCOWdataItem5.Name := Cname; CCOWdataItem5.Value := Uname; CCOWdata.Add(CCOWdataItem5); //Part 3 Make change Contextor.EndContextChange(true, CCOWdata); //We don't need to check CCOWresponce finally end; //try end; //if end; //Get Token from CCOW context function TCCOWRPCBroker.GetCCOWtoken(Contextor: TContextorControl): string; var CCOWdataItem1: IContextItem; //CCOW CCOWcontextItem: IContextItemCollection; //CCOW name: string; begin result := ''; name := CCOW_LOGON_TOKEN; if (Contextor <> nil) then try CCOWcontextItem := Contextor.CurrentContext; //See if context contains the ID item CCOWdataItem1 := CCOWcontextItem.Present(name); if (CCOWdataItem1 <> nil) then //1 begin result := CCOWdataItem1.Value; if not (result = '') then FWasUserDefined := True; end; FCCOWLogonIDName := CCOW_LOGON_ID; FCCOWLogonName := CCOW_LOGON_NAME; FCCOWLogonVpid := CCOW_LOGON_VPID; CCOWdataItem1 := CCOWcontextItem.Present(CCOW_LOGON_ID); if CCOWdataItem1 <> nil then FCCOWLogonIdValue := CCOWdataItem1.Value; CCOWdataItem1 := CCOWcontextItem.Present(CCOW_LOGON_NAME); if CCOWdataItem1 <> nil then FCCOWLogonNameValue := CCOWdataItem1.Value; CCOWdataItem1 := CCOWcontextItem.Present(CCOW_LOGON_VPID); if CCOWdataItem1 <> nil then FCCOWLogonVpidValue := CCOWdataItem1.Value; finally end; //try end; //Get Name from CCOW context function TCCOWRPCBroker.GetCCOWduz(Contextor: TContextorControl): string; var CCOWdataItem1: IContextItem; //CCOW CCOWcontextItem: IContextItemCollection; //CCOW name: string; begin result := ''; name := CCOW_LOGON_ID; if (Contextor <> nil) then try CCOWcontextItem := Contextor.CurrentContext; //See if context contains the ID item CCOWdataItem1 := CCOWcontextItem.Present(name); if (CCOWdataItem1 <> nil) then //1 begin result := CCOWdataItem1.Value; if result <> '' then FWasUserDefined := True; end; finally end; //try end; function TCCOWRPCBroker.IsUserContextPending(aContextItemCollection: IContextItemCollection): Boolean; var CCOWdataItem1: IContextItem; //CCOW Val1: String; begin result := false; if WasUserDefined() then // indicates data was defined begin Val1 := ''; // look for any USER Context items defined result := True; // CCOWdataItem1 := aContextItemCollection.Present(CCOW_LOGON_ID); if (CCOWdataItem1 <> nil) then //1 Val1 := CCOWdataItem1.Value; // CCOWdataItem1 := aContextItemCollection.Present(CCOW_LOGON_ID); if CCOWdataItem1 <> nil then Val1 := Val1 + '^' + CCOWdataItem1.Value; // CCOWdataItem1 := aContextItemCollection.Present(CCOW_LOGON_NAME); if CCOWdataItem1 <> nil then Val1 := Val1 + '^' + CCOWdataItem1.Value; // CCOWdataItem1 := aContextItemCollection.Present(CCOW_LOGON_VPID); if CCOWdataItem1 <> nil then Val1 := Val1 + '^' + CCOWdataItem1.Value; // CCOWdataItem1 := aContextItemCollection.Present(CCOW_USER_NAME); if CCOWdataItem1 <> nil then Val1 := Val1 + '^' + CCOWdataItem1.Value; // if Val1 <> '' then // something defined, so not user context change result := False; end; end; end.