Subversion Repositories DevTools

Rev

Rev 1282 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
2 rsolanki 1
<%
2
'=============================================================
3
'//
4
'//						Access Control
5
'//
6
'// version: 		0.10
7
'//	last modified: 	14-Jul-2004 15:48 by Sasha Vukovic
8
'=============================================================
9
%>
10
<%
11
'--------------- Global Constants ----------------
12
Const enumSESSION_TIMEOUT = 60
13
Const enumLOGIN_TOKEN_SESSION = "AM_LOGIN_TOKEN"
14
Const enumUSER_ID_SESSION = "AM_USER_ID"
15
Const enumUSER_DETAILS_SESSION = "AM_USER_DETAILS"
16
Const enumUSER_APPLICATIONS_SESSION = "AM_USER_APPLICATIONS"
17
Const enumACCESS_MANAGER_EVENT_LOGON_SUCCESS  = 1
18
Const enumACCESS_MANAGER_EVENT_LOGON_FAIL  	  = -1
19
Const enumACCESS_MANAGER_EVENT_LOGOFF 		  = 0
20
Const enumACCESS_MANAGER_EVENT_SESSION_EXPIRE = 2
21
'-------------------------------------------------
22
 
23
Class AccessControl
24
 
25
	Private mobjStaticControl
26
	Private mobjRowPermissions
27
	Private mobjTablePermissions
28
	Private sSEPARATOR
29
 
30
	Public Property Get UserLogedIn ()
31
		UserLogedIn = FALSE
32
 
33
		' Check for Session Token
34
		If (Session(enumLOGIN_TOKEN_SESSION) <> "") AND NOT IsNull(Session(enumLOGIN_TOKEN_SESSION)) Then  
35
			UserLogedIn = TRUE
36
		End If
37
 
38
	End Property
39
 
40
	Public Property Get UserId ()
41
		UserId = Session(enumUSER_ID_SESSION)
42
	End Property
43
 
44
	Public Property Get UserName ()
45
		UserName = Extract( "user_name", Session(enumUSER_DETAILS_SESSION) )
46
	End Property
47
 
48
	Public Property Get FullName ()
49
		FullName = Extract( "full_name", Session(enumUSER_DETAILS_SESSION) )
50
	End Property
51
 
52
	Public Property Get UserEmail ()
53
		UserEmail = Extract( "user_email", Session(enumUSER_DETAILS_SESSION) )
54
	End Property
55
 
56
	Public Property Get LastVisit ()
57
		LastVisit = Extract( "last_visit", Session(enumUSER_DETAILS_SESSION) )
58
	End Property
59
 
60
	'-----------------------------------------------------------------------------------------------------------------
61
	Public Function UserApplication ( nAppId )
62
		UserApplication = FALSE
63
 
64
		If InStr( sSEPARATOR & Session(enumUSER_APPLICATIONS_SESSION) & sSEPARATOR,  sSEPARATOR & nAppId & sSEPARATOR)  Then
65
			UserApplication = TRUE
66
		End If
67
 
68
	End Function
69
	'-----------------------------------------------------------------------------------------------------------------
70
	Public Function BeginRegion ( sControlObjName )
71
		Response.write "<table width='100%'  border='0' cellspacing='0' cellpadding='1'>"
72
		Response.write "  <tr>"
73
		Response.write "    <td bgcolor='#FF0000'>&nbsp;<a href='#' class='body_linkw'><b>"& sControlObjName &"</b></a>&nbsp;</td>"
74
		Response.write "  </tr>"
75
		Response.write "  <tr>"
76
		Response.write "    <td bgcolor='#FF0000'>"
77
		Response.write "		<table width='100%'  border='0' cellspacing='0' cellpadding='0'>"
78
		Response.write "  			<tr><td bgcolor='#FFFFFF'>"
79
	End Function
80
	'-----------------------------------------------------------------------------------------------------------------
81
	Public Function EndRegion ( sControlObjName )
82
		Response.write " 	</td></tr></table>"
83
		Response.write " </td></tr>"
84
		Response.write "</table>"
85
	End Function
86
	'-----------------------------------------------------------------------------------------------------------------
87
	Private Function Extract( sField, sString )
88
		Dim tempArr, tempSTR
89
 
90
		tempArr = Split( sString, sSEPARATOR )
91
		tempSTR = Join( Filter( tempArr, sField &"=" ) )	' Append "=" to field name to get e.g. "user_name="
92
 
93
		Extract = Right( tempSTR, Len(tempSTR) - Len( sField &"=" ))	' Strip the filed name from value
94
 
95
	End Function
96
	'-----------------------------------------------------------------------------------------------------------------
97
	Private Function GetDataPermission ( sTableName, nRowId, nPermissionType )
98
		Dim cPermissionValue
99
 
100
		'--- Get Row Permission ---
101
		cPermissionValue = mobjRowPermissions.Item ( Cstr( sTableName &"_"& nRowId &"_"& nPermissionType ) )
102
 
103
 
104
		'Response.write " VALUE="& cPermissionValue &" for "& sTableName &" "& nRowId &" "& nPermissionType &", "
105
 
106
 
107
		If IsNull( cPermissionValue )  OR  ( cPermissionValue = "" ) Then
108
 
109
			'--- Get Default Table Permission ---
110
			cPermissionValue = mobjTablePermissions.Item ( Cstr( sTableName &"_"& nPermissionType ) )
111
 
112
			'--- Raise Exception if Table Default is not found ---
113
			If IsNull( cPermissionValue )  OR  ( cPermissionValue = "" ) Then
114
				Err.Raise 8, "Default Table Permission is Not Found.", "sTableName="& sTableName &", nPermissionType="& nPermissionType
115
				Exit Function
116
			End If
117
 
118
 
119
			'Response.write " VALUE="& cPermissionValue &" for "& sTableName &" "& nRowId &" "& nPermissionType &", "
120
 
121
		End If
122
 
123
 
124
		'--- Return TRUE / FALSE ---
125
		GetDataPermission = FALSE
126
		If cPermissionValue = enumDB_YES Then
127
			GetDataPermission = TRUE
128
		End If
129
 
130
	End Function
131
	'-----------------------------------------------------------------------------------------------------------------
132
	Public Function IsDataVisible ( sTableName, nRowId )
133
		IsDataVisible = GetDataPermission ( sTableName, nRowId, enumDB_PERMISSION_TYPE_VISIBLE )
134
 
135
	End Function
136
	'-----------------------------------------------------------------------------------------------------------------
137
	Public Function IsDataActive ( sTableName, nRowId, sControlObjName )
138
		IsDataActive = FALSE
139
 
140
		If IsActive ( sControlObjName ) Then
141
			IsDataActive = GetDataPermission ( sTableName, nRowId, enumDB_PERMISSION_TYPE_ACTIVE )
142
		End If
143
 
144
	End Function
145
	'-----------------------------------------------------------------------------------------------------------------
146
	Public Function IsActive ( sControlObjName )
147
		If mobjStaticControl.Item (Cstr( sControlObjName &"_"&  enumDB_PERMISSION_TYPE_ACTIVE )) = enumDB_YES Then
148
			IsActive = TRUE
149
		Else
150
			IsActive = FALSE
151
		End If
152
	End Function
153
	'-----------------------------------------------------------------------------------------------------------------
154
	Public Function IsVisible ( sControlObjName )
155
		If mobjStaticControl.Item (Cstr( sControlObjName &"_"& enumDB_PERMISSION_TYPE_VISIBLE )) = enumDB_YES Then
156
			IsVisible = TRUE
157
		Else
158
			IsVisible = FALSE
159
		End If
160
	End Function
161
	'-----------------------------------------------------------------------------------------------------------------
162
	Public Sub LoadDataPermissions ( aRows )
163
		Dim numOfRows, rowNum
164
		Dim InxTableName, InxRefColumnVal, InxPermissionType, InxPermission
165
 
166
		InxTableName		= 0
167
		InxRefColumnVal		= 1
168
		InxPermissionType	= 2
169
		InxPermission		= 3
170
 
171
		numOfRows = UBound( aRows, 2 )
172
 
173
		For rowNum = 0 To numOfRows
174
 
175
 
176
			If aRows( InxRefColumnVal, rowNum ) = 0 Then
177
				'--- Set Table Default Permission (i.e. "0" wildcard for "all records") ---
178
				mobjTablePermissions.Item ( aRows( InxTableName, rowNum ) &"_"& aRows( InxPermissionType, rowNum ) ) = aRows( InxPermission, rowNum )
179
 
180
			Else
181
				'--- Set Row Permission ---
182
				mobjRowPermissions.Item ( aRows( InxTableName, rowNum ) &"_"& aRows( InxRefColumnVal, rowNum ) &"_"& aRows( InxPermissionType, rowNum ) ) = aRows( InxPermission, rowNum )
183
 
184
			End If
185
 
186
 
187
		Next
188
 
189
		'Response.write "mobjRowPermissions.Keys="& Join ( mobjRowPermissions.Keys, ", ") &"<br>"
190
		'Response.write "mobjRowPermissions.Items="& Join ( mobjRowPermissions.Items, ", ") &"<br>"
191
		'Response.write "mobjTablePermissions.Keys="& Join ( mobjTablePermissions.Keys, ", ") &"<br>"
192
		'Response.write "mobjTablePermissions.Items="& Join ( mobjTablePermissions.Items, ", ") &"<br>"
193
	End Sub
194
	'-----------------------------------------------------------------------------------------------------------------
195
	Public Sub LoadDataPermissionVariations ( aRows )
196
		Dim numOfRows, rowNum
197
		Dim InxTableName, InxRefColumnVal, InxPermissionType, InxPermission
198
 
199
		InxTableName		= 0
200
		InxRefColumnVal		= 1
201
		InxPermissionType	= 2
202
		InxPermission		= 3
203
 
204
		numOfRows = UBound( aRows, 2 )
205
 
206
		For rowNum = 0 To numOfRows
207
			If mobjRowPermissions.Exists ( aRows( InxTableName, rowNum ) &"_"& enumDB_ALL_DATA &"_"& aRows( InxPermissionType, rowNum ) )Then 
208
				mobjRowPermissions.Remove ( aRows( InxTableName, rowNum ) &"_"& enumDB_ALL_DATA &"_"& aRows( InxPermissionType, rowNum ) )
209
			End If
210
 
211
			mobjRowPermissions.Item ( aRows( InxTableName, rowNum ) &"_"& aRows( InxRefColumnVal, rowNum ) &"_"& aRows( InxPermissionType, rowNum ) ) = CStr( aRows( InxPermission, rowNum ) )
212
 
213
			If aRows( InxPermission, rowNum ) = enumDB_NO Then
214
				mobjTablePermissions.Item ( aRows( InxTableName, rowNum ) &"_"& aRows( InxPermissionType, rowNum ) ) =  enumDB_YES
215
			Else
216
				mobjTablePermissions.Item ( aRows( InxTableName, rowNum ) &"_"& aRows( InxPermissionType, rowNum ) ) =  enumDB_NO
217
 
218
			End If
219
 
220
 
221
		Next
222
		'Response.write "mobjRowPermissions.Keys="& Join ( mobjRowPermissions.Keys, ", ")
223
	End Sub
224
	'-----------------------------------------------------------------------------------------------------------------
225
	Public Sub LoadStaticPermissions ( aRows )
226
		Dim numOfRows, rowNum
227
		Dim InxObjName, InxPermissionType, InxPermission
228
 
229
		InxObjName 			= 0
230
		InxPermissionType	= 1
231
		InxPermission		= 2
232
 
233
		numOfRows = UBound( aRows, 2 )
234
 
235
		For rowNum = 0 To numOfRows
236
 
237
			mobjStaticControl.Add ( aRows( InxObjName, rowNum ) &"_"&  aRows( InxPermissionType, rowNum ) ), CStr( aRows( InxPermission, rowNum ) )
238
			'Response.write " "& aRows( InxObjName, rowNum ) &"_"&  aRows( InxPermissionType, rowNum ) &"="& CStr( aRows( InxPermission, rowNum ) )
239
 
240
		Next
241
 
242
 
243
	End Sub
244
	'-----------------------------------------------------------------------------------------------------------------
245
	Private Function AutoLogonUser ( sUserId )
246
		Dim rsQry, query, is_Online
247
		AutoLogonUser = FALSE
248
 
249
 
250
		'--- Get if user is loged on from DB ---
251
		OraDatabase.Parameters.Add "USER_ID",  sUserId, ORAPARM_INPUT, ORATYPE_NUMBER
252
 
253
		query = "SELECT usr.IS_ONLINE  FROM USERS usr  WHERE usr.USER_ID = :USER_ID"
254
		Set rsQry = OraDatabase.DbCreateDynaset( query , ORADYN_DEFAULT )
255
 
256
		If (NOT rsQry.BOF) AND (NOT rsQry.EOF) Then
257
			is_Online = rsQry("is_online")
258
		End If
259
 
260
		OraDatabase.Parameters.Remove "USER_ID"
261
		rsQry.Close
262
		Set rsQry = Nothing
263
 
264
 
265
		'--- Check if User is still Loged on ---
266
		If is_Online = "Y" Then
267
			Call SessionsAndCookieSetup ( sUserId )
268
 
269
		End If
270
 
271
 
272
	End Function
273
	'-----------------------------------------------------------------------------------------------------------------
274
	Public Sub LogonUser ( sUserName, sUserPassword, ByRef oDBsession )
275
		Dim rsQry, query, sMessage
276
		sMessage = NULL
277
 
278
		OraDatabase.Parameters.Add "USER_NAME",   	sUserName, 		ORAPARM_INPUT, ORATYPE_VARCHAR2
279
 
280
		query = "SELECT usr.*  FROM USERS usr  WHERE usr.USER_NAME = :USER_NAME"
281
		Set rsQry = OraDatabase.DbCreateDynaset( query , ORADYN_DEFAULT )
282
 
283
 
284
		'--- Try Authenticating ---
285
		If (NOT rsQry.BOF) AND (NOT rsQry.EOF) Then
286
			' User Found !
287
 
288
			If rsQry("is_disabled") = enumDB_YES  Then
289
				' User Disabled !
290
				sMessage = "Account <b>"& sUserName &"</b> is Disabled!"
291
 
292
				'-- Login Trail --
293
				Call LoginTrail ( enumACCESS_MANAGER_EVENT_LOGON_FAIL, sUserName, sMessage )
294
 
295
				'-- Raise Exception --
296
				Err.Raise 8, sMessage, "" 
297
 
298
			Else
299
 
300
				' Proceed with authentication
3927 dpurdie 301
				If Authenticated( sUserName, sUserPassword, rsQry("user_password"), rsQry("domain") ) Then
2 rsolanki 302
					' Login OK.
303
					Call SessionsAndCookieSetup ( rsQry("user_id") )
304
 
305
					' Tag user login
306
					Call TagLogon ( rsQry )
307
 
308
				End If
309
 
310
 
311
			End If
312
 
313
		Else
314
			' User Not Found !
315
			sMessage = "Account <b>"& sUserName &"</b> Not Found!"
316
 
317
			'-- Login Trail --
318
			Call LoginTrail ( enumACCESS_MANAGER_EVENT_LOGON_FAIL, sUserName, sMessage )
319
 
320
			'-- Raise Exception --
321
			Err.Raise 8, sMessage, "Make sure your Username is correct <br>OR <br>Please go back and register if you are new user. " 
322
 
323
		End If
324
		'--------------------------
325
 
326
 
327
		OraDatabase.Parameters.Remove "USER_NAME"
328
 
329
		rsQry.Close()
330
		Set rsQry = Nothing
331
	End Sub
332
	'-----------------------------------------------------------------------------------------------------------------
333
	Public Sub LogoffUser ()
334
		'-- Login Trail --
335
		Call LoginTrail ( enumACCESS_MANAGER_EVENT_LOGOFF, UserName, NULL )
336
 
337
		'-- Kill User Session --
338
		Session.Abandon
339
 
340
	End Sub
341
	'-----------------------------------------------------------------------------------------------------------------
342
	Private Sub SessionsAndCookieSetup ( nUserId )
343
		' Store User details in session
344
		Call SetUserEnvironment ( nUserId )
345
 
346
		' Aquire Login Token for Single Application
347
		Session(enumLOGIN_TOKEN_SESSION) = Session.SessionID
348
 
349
		Session.Timeout = enumSESSION_TIMEOUT
350
	End Sub
351
	'-----------------------------------------------------------------------------------------------------------------
352
	Private Function Authenticated ( ByRef sUserName, ByRef sUserPassword, sDBUserPassword, sDBdomain )
353
		Dim objLoginAuth, return, sMessage
354
		sMessage = NULL
355
 
356
		Authenticated = FALSE
357
 
358
		If NOT IsNull(sDBdomain) Then
359
			' DOMAIN auth.
360
 
361
			Set objLoginAuth = Server.CreateObject("LoginAdmin.ImpersonateUser")
362
 
363
			return = -1
364
			return = objLoginAuth.AuthenticateUser ( sUserName, sUserPassword, sDBdomain )
365
 
366
			' From MSDN System Error Codes
367
			' 0 - The operation completed successfully.
368
			' 1326 - Logon failure: unknown user name or bad password.
369
			' 1385 - Logon failure: the user has not been granted the requested logon type at this computer.
370
			' 1909 - The referenced account is currently locked out and may not be used to log on.
371
 
372
			Select Case return
373
				Case 0, 1385
374
					'Login ok
375
					Authenticated = TRUE
376
 
377
					'-- Login Trail --
378
					Call LoginTrail ( enumACCESS_MANAGER_EVENT_LOGON_SUCCESS, sUserName, NULL )
379
 
380
				Case 1909
381
					sMessage = "Account <b>"& sUserName &"</b> at "& sDBdomain &" domain is currently locked!"
382
 
383
					'-- Login Trail --
384
					Call LoginTrail ( enumACCESS_MANAGER_EVENT_LOGON_FAIL, sUserName, sMessage )
385
 
386
					'-- Raise Exception --
387
					Err.Raise 8, sMessage, ""
388
 
389
 
390
				Case Else
391
					sMessage = "Password is incorrect for <b>"& sUserName &"</b> at "& sDBdomain &" domain!"
392
 
393
					'-- Login Trail --
394
					Call LoginTrail ( enumACCESS_MANAGER_EVENT_LOGON_FAIL, sUserName, sMessage )
395
 
396
					'-- Raise Exception --
397
					Err.Raise 8, sMessage, sDBdomain &" domain returns system error code "& return
398
 
399
			End Select
400
 
401
			Set objLoginAuth = Nothing
402
 
403
		Else
404
			' LOCAL auth.
405
			If sUserPassword = sDBUserPassword Then
406
				'Login ok
407
				Authenticated = TRUE
408
 
409
				'-- Login Trail --
410
				Call LoginTrail ( enumACCESS_MANAGER_EVENT_LOGON_SUCCESS, sUserName, NULL )
411
 
412
			Else
413
				sMessage = "Password is incorrect for <b>"& sUserName &"</b>!"
414
 
415
				'-- Login Trail --
416
				Call LoginTrail ( enumACCESS_MANAGER_EVENT_LOGON_FAIL, sUserName, sMessage )
417
 
418
				'-- Raise Exception --
419
				Err.Raise 8, sMessage, "Please try again and make sure you do not have Caps Lock on."
420
 
421
			End If
422
 
423
		End If
424
 
425
 
426
 
427
	End Function
428
	'-----------------------------------------------------------------------------------------------------------------
429
	Private Sub LoginTrail ( nEvent, sUserName, sMessage )
430
 
431
		OraDatabase.Parameters.Add "EVENT_ENUM",   		nEvent, 		ORAPARM_INPUT, ORATYPE_NUMBER
432
		OraDatabase.Parameters.Add "LOGIN_USER_NAME",   sUserName, 		ORAPARM_INPUT, ORATYPE_VARCHAR2
433
		OraDatabase.Parameters.Add "CLIENT_IP",   		Request.ServerVariables("REMOTE_ADDR"), 		ORAPARM_INPUT, ORATYPE_VARCHAR2
434
		OraDatabase.Parameters.Add "APPLICATION_ID",   	APPLICATION_ID, 		ORAPARM_INPUT, ORATYPE_NUMBER
435
		OraDatabase.Parameters.Add "LOGIN_COMMENTS",   	sMessage, 		ORAPARM_INPUT, ORATYPE_VARCHAR2
436
 
437
 
438
		OraSession.BeginTrans
439
 
440
		OraDatabase.ExecuteSQL _
441
		"BEGIN   pk_AMUtils.Log_Access ( :EVENT_ENUM, :LOGIN_USER_NAME, :CLIENT_IP, :APPLICATION_ID, :LOGIN_COMMENTS );   END;"
442
 
443
		OraSession.CommitTrans
444
 
445
 
446
		OraDatabase.Parameters.Remove "EVENT_ENUM"
447
		OraDatabase.Parameters.Remove "LOGIN_USER_NAME"
448
		OraDatabase.Parameters.Remove "CLIENT_IP"
449
		OraDatabase.Parameters.Remove "APPLICATION_ID"
450
		OraDatabase.Parameters.Remove "LOGIN_COMMENTS"
451
 
452
 
453
	End Sub
454
	'-----------------------------------------------------------------------------------------------------------------
455
	Private Sub TagLogon ( oRsQry )
456
		oRsQry.Edit()
457
 
458
		oRsQry("is_online").Value = "Y"
459
		oRsQry("online_at").Value = Request.ServerVariables("REMOTE_ADDR")
460
 
461
		oRsQry.Update()
462
	End Sub
463
	'-----------------------------------------------------------------------------------------------------------------
464
	Private Sub SetUserEnvironment ( nUser_id )
465
		Dim rsUser, query, tempSTR
466
 
467
		OraDatabase.Parameters.Add "USER_ID", nUser_id, ORAPARM_INPUT, ORATYPE_NUMBER
468
 
469
 
470
 
471
		'---- Get User Details ----
472
		query = "SELECT usr.*  FROM USERS usr  WHERE usr.USER_ID = :USER_ID"
473
		Set rsUser = OraDatabase.DbCreateDynaset( query , ORADYN_DEFAULT )
474
 
475
		If (NOT rsUser.BOF) AND (NOT rsUser.EOF) Then
476
			Session(enumUSER_ID_SESSION) = rsUser("user_id")
477
 
478
			Session(enumUSER_DETAILS_SESSION) = _
479
				"user_name="& rsUser("user_name") & sSEPARATOR &_
480
				"full_name="& rsUser("full_name") & sSEPARATOR &_
481
				"user_email="& rsUser("user_email") & sSEPARATOR &_
482
				"last_visit="& rsUser("last_visit") 
483
 
484
		End If
485
 
486
 
487
 
488
		'---- Get User Applications ----
489
		query = "SELECT ua.APP_ID  FROM USER_APPLICATIONS ua  WHERE ua.USER_ID = :USER_ID"
490
		Set rsUser = OraDatabase.DbCreateDynaset( query , ORADYN_DEFAULT )
491
		tempSTR = ""
492
		While (NOT rsUser.BOF) AND (NOT rsUser.EOF) 
493
			tempSTR = tempSTR & sSEPARATOR & rsUser("app_id")
494
			rsUser.MoveNext()
495
		WEnd
496
 
497
		If tempSTR <> "" Then
498
			Session(enumUSER_APPLICATIONS_SESSION) = Right( tempSTR, Len(tempSTR) - Len(sSEPARATOR) )	'Remove first separator
499
		Else
500
			Session(enumUSER_APPLICATIONS_SESSION) = 0
501
		End If
502
 
503
 
504
 
505
		OraDatabase.Parameters.Remove "USER_ID"
506
 
507
		rsUser.Close()
508
		Set rsUser = Nothing
509
	End Sub
510
	'-----------------------------------------------------------------------------------------------------------------
511
	Private Sub Class_Initialize()
512
		'// Perform action on creation of object. e.g. Set myObj = New ThisClassName
513
		Set mobjStaticControl = CreateObject("Scripting.Dictionary")
514
		Set mobjTablePermissions = CreateObject("Scripting.Dictionary")
515
		Set mobjRowPermissions = CreateObject("Scripting.Dictionary")
516
 
517
		sSEPARATOR = "||"
518
 
519
	End Sub
520
	'-----------------------------------------------------------------------------------------------------------------
521
	Private Sub Class_Terminate()
522
		'// Perform action on object disposal. e.g. Set myObj = Nothing
523
		Set mobjStaticControl = Nothing
524
		Set mobjRowPermissions = Nothing
525
		Set mobjTablePermissions = Nothing
526
 
527
	End Sub
528
	'-----------------------------------------------------------------------------------------------------------------
529
End Class
530
%>