' Copyright (c) 2008 Pathfinder Software, LLC. All Rights Reserved.
' Pathfinder Software <http://www.pfasoft.com>
' PartialAuthenticationSystem is distributed under the terms of the GNU Lesser General Public License (GPL)
' PartialAuthenticationSystem is free software: you can redistribute it and/or modify
' it under the terms of the GNU Lesser General Public License as published by
' the Free Software Foundation, either version 3 of the License, or
' (at your option) any later version.
' PartialAuthenticationSystem is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU Lesser General Public License for more details.
' You should have received a copy of the GNU Lesser General Public License
' along with PartialAuthenticationSystem. If not, see <http://www.gnu.org/licenses/>.
Imports System.Runtime.InteropServices
Imports System.Web.Configuration
Public NotInheritable Class PartialAuthentication
Private Shared _lockObject As New Object()
Private Shared _Initialized As Boolean = False
Private Shared _IdentityTimeout As Integer
Private Shared _IdentityCookieName As String
Public Shared ReadOnly Property IdentityCookieName() As String
Get
Return _IdentityCookieName
End Get
End Property
Private Shared _RequireSSL As Boolean
Public Shared ReadOnly Property RequireSSL() As Boolean
Get
Return _RequireSSL
End Get
End Property
Public Sub New()
End Sub
Public Shared Function Decrypt(ByVal encryptedTicket As String) As FormsAuthenticationTicket
If encryptedTicket Is Nothing Then Return Nothing
Initialize()
Dim ticket As FormsAuthenticationTicket = FormsAuthentication.Decrypt(encryptedTicket)
If Not ticket.Name.StartsWith(_IdentityCookieName) Then Return Nothing
Return New FormsAuthenticationTicket(ticket.Version, ticket.Name.Remove(0, _IdentityCookieName.Length), ticket.IssueDate, ticket.Expiration, ticket.IsPersistent, ticket.UserData, ticket.CookiePath)
End Function
Public Shared Function Encrypt(ByVal ticket As FormsAuthenticationTicket) As String
If ticket Is Nothing Then Throw New ArgumentNullException("ticket")
Initialize()
ticket = New FormsAuthenticationTicket(ticket.Version, _IdentityCookieName & ticket.Name, ticket.IssueDate, ticket.Expiration, ticket.IsPersistent, ticket.UserData, ticket.CookiePath)
Return FormsAuthentication.Encrypt(ticket)
End Function
Public Shared Function GetAuthCookie(ByVal userName As String, ByVal createPersistentCookie As Boolean) As HttpCookie
Return GetAuthCookie(userName, createPersistentCookie, Nothing)
End Function
Public Shared Function GetAuthCookie(ByVal userName As String, ByVal createPersistentCookie As Boolean, ByVal strCookiePath As String) As HttpCookie
Initialize()
If userName Is Nothing Then userName = String.Empty
If strCookiePath Is Nothing OrElse strCookiePath.Length = 0 Then
strCookiePath = FormsAuthentication.FormsCookiePath
End If
Dim ticket As New FormsAuthenticationTicket(2, userName, DateTime.Now, DateTime.Now.AddMinutes(_IdentityTimeout), createPersistentCookie, String.Empty)
Return GetAuthCookie(ticket)
End Function
Private Shared Function GetAuthCookie(ByVal ticket As FormsAuthenticationTicket) As HttpCookie
Initialize()
Dim cookieStr As String = Encrypt(ticket)
If cookieStr Is Nothing OrElse cookieStr.Length = 0 Then
Throw New HttpException("Unable To Encrypt Cookie Ticket")
End If
Dim cookie As New HttpCookie(IdentityCookieName, cookieStr)
cookie.HttpOnly = True
cookie.Path = FormsAuthentication.FormsCookiePath
cookie.Domain = FormsAuthentication.CookieDomain
If ticket.IsPersistent Then
cookie.Expires = ticket.Expiration
End If
cookie.Secure = RequireSSL
Return cookie
End Function
Public Shared Sub Initialize()
If _Initialized Then Exit Sub
SyncLock _lockObject
Dim section As PartialAuthenticationSection = WebConfigurationManager.GetSection("partialAuthenticationSystem/authentication")
_IdentityCookieName = section.Name
_RequireSsl = section.RequireSSL
_IdentityTimeout = section.Timeout
_Initialized = True
End SyncLock
End Sub
Public Shared Sub RedirectFromLoginPage(ByVal userName As String, ByVal createPersistentCookie As Boolean)
SetAuthCookie(userName, createPersistentCookie)
FormsAuthentication.RedirectFromLoginPage(userName, False)
End Sub
Public Shared Sub RedirectFromLoginPage(ByVal userName As String, ByVal createPersistentCookie As Boolean, ByVal strCookiePath As String)
SetAuthCookie(userName, createPersistentCookie, strCookiePath)
FormsAuthentication.RedirectFromLoginPage(userName, False, strCookiePath)
End Sub
Public Shared Sub RenewTicketIfOld(ByVal context As HttpContext, ByVal ticket As FormsAuthenticationTicket)
Initialize()
If context Is Nothing Then Throw New ArgumentNullException("context")
If ticket Is Nothing Then Exit Sub
If DateTime.Now - ticket.IssueDate > ticket.Expiration - DateTime.Now Then ' more than halfway to expiration
ticket = New FormsAuthenticationTicket(ticket.Version, ticket.Name, Now, Now + (ticket.Expiration - ticket.IssueDate), ticket.IsPersistent, ticket.UserData, ticket.CookiePath)
Dim cookie As HttpCookie = GetAuthCookie(ticket)
context.Response.Cookies.Add(cookie)
End If
End Sub
Public Shared Sub SetAuthCookie(ByVal userName As String, ByVal createPersistentCookie As Boolean)
Dim Cookie As HttpCookie = GetAuthCookie(userName, createPersistentCookie)
HttpContext.Current.Response.Cookies.Add(Cookie)
End Sub
Public Shared Sub SetAuthCookie(ByVal userName As String, ByVal createPersistentCookie As Boolean, ByVal strCookiePath As String)
Dim Cookie As HttpCookie = GetAuthCookie(userName, createPersistentCookie, strCookiePath)
HttpContext.Current.Response.Cookies.Add(Cookie)
End Sub
Public Shared Sub SignOut()
SignOut(True)
End Sub
Public Shared Sub SignOut(ByVal signOutForms As Boolean)
Dim Response As HttpResponse = HttpContext.Current.Response
Dim Cookie As HttpCookie = Response.Cookies(IdentityCookieName)
If Not Cookie Is Nothing Then
Cookie = New HttpCookie(IdentityCookieName)
Cookie.Expires = DateTime.Now.AddDays(-1)
Response.Cookies.Add(Cookie)
End If
If signOutForms Then
FormsAuthentication.SignOut()
End If
End Sub
End Class