project BLF > class Session > method CheckLogin
Description
Check the validity of provided login and password and if this user has access to selected domain and company.
Parameters
| icLogin | input | character | |
| icPassword | input | character | |
| icExtra | input | character | |
| olValid | output | logical | |
| oiReturnStatus | output | integer | Return status of the method. |
Internal usage
BLF
program code (program3/session.p)
if oiReturnStatus = 0
then oiReturnStatus = -98.
if icLogin = "":U or
icLogin = ?
then do:
<M-1 run SetMessage
(input #T-1'You must enter the user ID to log in.':100(4569)T-1# (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-388':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in Session>
assign oiReturnStatus = -1.
return.
end.
if vcUserFromUIShell = "":U or
vcUserFromUIShell = ?
then do:
if com.qad.qra.config.QraConfig:IsEnabled
then do:
<I-8 {bFcStartAndOpenInstance
&CLASS = "PAuthenticationQRA"}>
<M-78 run AuthenticateWrapper
(input icLogin (icLogin),
input icPassword (icPassword),
output vcGlobalSessionId (ocGlobalSessionId),
output vcCPO (ocClientPrincipalObject),
output viReturn (oiReturnStatus)) in PAuthenticationQRA>
<I-75 {bFcCloseAndStopInstance
&CLASS = "PAuthenticationQRA"}>
end.
else do:
<I-42 {bFcStartAndOpenInstance
&CLASS = "PAuthentication"}>
<M-46 run AuthenticateWrapper
(input icLogin (icLogin),
input icPassword (icPassword),
output vcGlobalSessionId (ocGlobalSessionId),
output vcCPO (ocClientPrincipalObject),
output viReturn (oiReturnStatus)) in PAuthentication>
<I-43 {bFcCloseAndStopInstance
&CLASS = "PAuthentication"}>
end.
if viReturn < 0
then do:
assign oiReturnStatus = viReturn.
return.
end.
/*
<M-49 run RegisterClientPrincipalInPool
(input 'showusage' (icObjectKey),
output viFcReturnSuper (oiReturnStatus)) in ComponentPool>
*/
run RegisterClientPrincipalInPool (input vcCPO, output viFcReturnSuper).
if viFcReturnSuper <> 0
then oiReturnStatus = viFcReturnSuper.
if viFcReturnSuper < 0
then return.
<M-47 run SetCharacterValue
(input 'CPO' (icName),
input vcCPO (icValue),
output viFcReturnSuper (oiReturnStatus)) in Session>
end.
/* Fill viCompanyId and vcTmpCompCode */
assign viFcCount1 = lookup("CompanyId":U, icExtra, chr(2)).
if viFcCount1 > 0
then assign viCompanyId = int(entry(viFcCount1 + 1, icExtra, chr(2)))
vcTmpCompCode = "":U
no-error.
else do:
assign viFcCount1 = lookup("CompanyCode":U, icExtra, chr(2)).
if viFcCount1 > 0
then assign vcTmpCompCode = entry(viFcCount1 + 1, icExtra, chr(2))
viCompanyId = ?
no-error.
end.
/* Company is mandatory */
if (icLogin ne "mfg":U) and
(viCompanyId = ? or
viCompanyId = 0) and
(vcTmpCompCode = ? or
vcTmpCompCode = "":U)
then do:
<M-9 run SetMessage
(input #T-20'You must enter either the ID or the code of an entity to log in.':255(5015986)T-20# (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-389':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in Session>
assign oiReturnStatus = -1.
return.
end.
/* Check if Company exists */
<Q-10 run CompanyByCodeActiveID (all) (Read) (NoCache)
(input viCompanyId, (CompanyId)
input vcTmpCompCode, (CompanyCode)
input ?, (CompanyIsActive)
output dataset tqCompanyByCodeActiveID) in BCompany >
find tqCompanyByCodeActiveID
no-lock no-error.
/* No checks for user mfg but viCompanyId and vcTmpCompCode must be set anyway for the daemons */
if icLogin = "mfg":U
then do:
assign oiReturnStatus = 0
olValid = true.
if available(tqCompanyByCodeActiveID)
then assign
viCompanyId = tqCompanyByCodeActiveID.tiCompany_ID
vcTmpCompCode = tqCompanyByCodeActiveID.tcCompanyCode.
empty temp-table tqCompanyByCodeActiveID.
return.
end.
if not available tqCompanyByCodeActiveID
then do:
<M-26 run SetMessage
(input trim(subst(#T-22'Unable to log in with this entity ID (&1) or entity code (&2).':255(4498294)T-22#,(if viCompanyId = ? then '?':U else string(viCompanyId)),(if vcTmpCompCode = ? then '?':U else vcTmpCompCode))) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-390':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in Session>
assign oiReturnStatus = -1.
return.
end.
/* Company must be active */
if tqCompanyByCodeActiveID.tlCompanyIsActive <> true
then do:
<M-27 run SetMessage
(input trim(subst(#T-23'Unable to log in with an inactive entity (entity ID: &1 / entity code: &2).':255(8467486)T-23#,(if viCompanyId = ? then '?':U else string(viCompanyId)),(if vcTmpCompCode = ? then '?':U else vcTmpCompCode))) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-391':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in Session>
assign oiReturnStatus = -1.
return.
end.
/* Properly fill viCompanyId and vcTmpCompCode, this is passed to ApplicationLogin in Login */
assign viCompanyId = tqCompanyByCodeActiveID.tiCompany_ID
vcTmpCompCode = tqCompanyByCodeActiveID.tcCompanyCode.
if tqCompanyByCodeActiveID.tlDomainIsActive <> true
then do:
assign vcMsg = trim(subst(#T-35'The entity you specified belongs to an inactive domain (&1).':255(6776)T-35#, tqCompanyByCodeActiveID.tcDomainCode)).
<M-36 run SetMessage
(input vcMsg (icMessage),
input '':U (icArguments),
input '':U (icFieldName),
input '':U (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input '':U (icRowid),
input 'BLF-393':U (icFcMsgNumber),
input '':U (icFcExplanation),
input '':U (icFcIdentification),
input '':U (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in Session>
assign oiReturnStatus = -1.
return.
end.
/* Check if the user has access to the domain */
<Q-41 assign vlFcQueryRecordsAvailable = UsrDomainByDomainLogin (NoCache)
(input icLogin, (UsrLogin)
input tqCompanyByCodeActiveID.tcDomainCode, (DomainCode)) in BUser >
if vlFcQueryRecordsAvailable = false
then do:
assign vcMsg = trim(subst(#T-39'You do not have access to this domain (&1).':255(6778)T-39#, tqCompanyByCodeActiveID.tcDomainCode)).
<M-38 run SetMessage
(input vcMsg (icMessage),
input '':U (icArguments),
input '':U (icFieldName),
input '':U (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input '':U (icRowid),
input 'BLF-394':U (icFcMsgNumber),
input '':U (icFcExplanation),
input '':U (icFcIdentification),
input '':U (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in Session>
assign oiReturnStatus = -1.
return.
end.
/* Check if the user has access to the company */
<Q-40 assign vlFcQueryRecordsAvailable = UserCompanies (NoCache)
(input icLogin, (UserLogin)
input viCompanyId, (CyId)
input 0, (DomainId)) in BUser >
if vlFcQueryRecordsAvailable = false
then do:
<M-28 run SetMessage
(input trim(substitute(#T-24'You do not have permission to access this entity (&1).':255(3838843)T-24#,(if viCompanyId = ? then '?':U else string(viCompanyId)))) (icMessage),
input '' (icArguments),
input '' (icFieldName),
input '' (icFieldValue),
input 'E':U (icType),
input 3 (iiSeverity),
input '' (icRowid),
input 'BLF-392':U (icFcMsgNumber),
input '' (icFcExplanation),
input '' (icFcIdentification),
input '' (icFcContext),
output viFcReturnSuper (oiReturnStatus)) in Session>
assign oiReturnStatus = -1.
return.
end.
empty temp-table tqCompanyByCodeActiveID.
if oiReturnStatus = -98
then assign oiReturnStatus = viReturn
olValid = true.
Sample code: how to call this method through RPCRequestService (QXtend Inbound)
define temp-table ttContext no-undo
field propertyQualifier as character
field propertyName as character
field propertyValue as character
index entityContext is primary unique
propertyQualifier
propertyName
index propertyQualifier
propertyQualifier.
define dataset dsContext for ttContext.
define variable vhContextDS as handle no-undo.
define variable vhExceptionDS as handle no-undo.
define variable vhServer as handle no-undo.
define variable vhInputDS as handle no-undo.
define variable vhInputOutputDS as handle no-undo.
define variable vhOutputDS as handle no-undo.
define variable vhParameter as handle no-undo.
/* Create context */
create ttContext.
assign ttContext.propertyName = "programName"
ttContext.propertyValue = "Session".
create ttContext.
assign ttContext.propertyName = "methodName"
ttContext.propertyValue = "CheckLogin".
create ttContext.
assign ttContext.propertyName = "applicationId"
ttContext.propertyValue = "fin".
create ttContext.
assign ttContext.propertyName = "entity"
ttContext.propertyValue = "1000".
create ttContext.
assign ttContext.propertyName = "userName"
ttContext.propertyValue = "mfg".
create ttContext.
assign ttContext.propertyName = "password"
ttContext.propertyValue = "".
/* Create input dataset */
create dataset vhInputDS.
vhInputDS:read-xmlschema("file", "xml/session.checklogin.i.xsd", ?).
vhParameter = vhInputDS:get-buffer-handle("tParameterI").
vhParameter:buffer-create().
assign vhParameter::icLogin = <parameter value>
vhParameter::icPassword = <parameter value>
vhParameter::icExtra = <parameter value>.
/* Connect the AppServer */
create server vhServer.
vhServer:connect("-URL <appserver-url>").
if not vhServer:connected()
then do:
message "Could not connect AppServer" view-as alert-box error title "Error".
return.
end.
/* Run */
assign vhContextDS = dataset dsContext:handle.
run program/rpcrequestservice.p on vhServer
(input-output dataset-handle vhContextDS by-reference,
output dataset-handle vhExceptionDS,
input dataset-handle vhInputDS by-reference,
input-output dataset-handle vhInputOutputDS by-reference,
output dataset-handle vhOutputDS).
/* Handle output however you want, in this example, we dump it to xml */
if valid-handle(vhExceptionDS)
then vhExceptionDS:write-xml("file", "Exceptions.xml", true).
if valid-handle(vhOutputDS)
then vhOutputDS:write-xml("file", "Output.xml", true).
/* Cleanup */
vhServer:disconnect().
assign vhServer = ?.
if valid-handle(vhInputDS)
then delete object vhInputDS.
if valid-handle(vhOutputDS)
then delete object vhOutputDS.
if valid-handle(vhExceptionDS)
then delete object vhExceptionDS.