Let me know what you think! Some official ME comments would be really nice!
Code: Select all
<%Option Explicit
Response.CacheControl = "no-cache"
Response.AddHeader "Pragma", "no-cache"
Response.AddHeader "cache-control", "private"
Response.Expires = -10000
Response.ExpiresAbsolute
Response.ExpiresAbsolute = Now - 2
Response.Buffer = True
'This code is what I plan on using on my site. It was fully written by me in the wee hours of the morn.
'I could not find anyone else that has written anything like this so I figured I would try to tackle my problem.
'When I setup my site, I do not plan on letting the users use all the cool features of ME; I think it would give them
'too much power. So, I am simply allowing for the creation of accounts and the creation of groups (I call them aliases).
'This script assumes you made a nice form that explains everything to the users. It also assumes that you did all the same
'string scrubbing and validation on the client side as well. If this script finds a problem, it sends you packing back
'to the mail page. Please let me know if you find this script useful.
'--Ken
'ADODB.Connection, ADODB.RecordSet, Object, String, String, Integer, Integer, Boolean
Dim Conn, rs, oObject, sMBX, sTemp, i, j, bCatch
Select Case Trim(Request.Form("type")) 'Getting the type of the new address
Case "1" : i = 1 'POP
Case "2" : i = 2 'Alias
Case Else : i = 0 'Error
End Select
'I like to put thier domain (postoffice) in Session at login, that way I know it cannot be changed
sTemp = "@" & Session("domain") 'We put this here because we will use it in another line or two
sMBX = LCase(Trim(Request.Form("name"))) 'Getting the name of the new box
If Right(sMBX, Len(sTemp)) = sTemp Then sMBX = Left(sMBX, Len(sMBX) - Len(sTemp)) 'We are checking to see if the retarded user put in thier domain name
bCatch = False 'Default val for testing
If i = 0 Then bCatch = True 'Checking our error above
If i = 1 Then 'If we have a POP box
sTemp = Request.Form("pass0") 'Reuse our var and get the password
If sTemp <> Request.Form("pass1") Then bCatch = True 'If the password matches the confirm we are good
If Len(sTemp) < 8 Then bCatch = True 'We want more than 7
If Len(sTemp) > 15 Then bCatch = True 'And less than 16
Else
sTemp = LCase(Trim(Request.Form("aliaslist"))) 'Reuse our var, This is where we will take in the alias list
sTemp = Replace(sTemp, vbCrLf, ",") 'Put commas in place of CrLf
Do While InStr(sTemp, ",,") > 0 'Looping to get rid of any double commas caused by multiple CrLf
sTemp = Replace(sTemp, ",,", ",") 'Replace proceadure
Loop
If Right(sTemp, 1) = "," Then sTemp = Left(sTemp, Len(sTemp) - 1) 'Get rid of trailing comma if any
sTemp = Split(sTemp, ",") 'Split the emails into an array
End If
If Len(sMBX) > 64 Then bCatch = True 'Check to see if we are over the length limit
Set oObject = New RegExp 'Now we will see if what they user gave us was a valid email address
oObject.IgnoreCase = False 'We don't care about case
oObject.Pattern = "^[\w-]+(?:\.[\w-]+)*@(?:[\w-]+\.)+[a-zA-Z]{2,7}$" 'This should work for just about any email address out there
If oObject.Test(sMBX & "@" & Session("domain")) = False Then bCatch = True 'We check to see if they gave us a good email
If i <> 1 And IsArray(sTemp) = True Then 'We check to see if the list they handed us will have good emails in it
For j = LBound(sTemp) To UBound(sTemp) 'Loop through the array
If oObject.Test(sTemp(j)) = False Then bCatch = True 'We check to see if all the emails are good, if not, we flag
If Len(sTemp(j)) > 64 Then bCatch = True 'We also check to see if we are over the length limit for those addresses
Next
End If
Set oObject = Nothing 'Always clean up!
If LCase(Request.ServerVariables("HTTP_REFERER")) <> "put in your own fully qualified domain name and referer here" Then bCatch = True 'Last test, lets make sure they came from our page
'If we got flagged in any way then just send them back to where they (should have) came from
'We wont throw the page an error becuase all of this code should have been checked by the JavaScript on client side first.
'We will assume they did something tricky.
If bCatch = True Then Response.Redirect("/admin/mail.asp")
Set Conn = Server.CreateObject("ADODB.Connection") 'Duh!
Set rs = Server.CreateObject("ADODB.RecordSet") 'Duh!
Conn.Open Application("SQL") 'Duh!
'Check to see if there is aleady a map out there
rs.Open "SELECT id FROM address_map WHERE account = '" & Session("domain") & "' AND sourceaddress = '[SMTP:" & sMBX & "@" & Session("domain") & "]'", Conn, 0, 1
bCatch = rs.EOF 'Reuse our var
rs.Close
If bCatch = True Then 'If EOF was true, we can add the new address maps
Select Case i 'What type of box?
Case 1 'Mailbox
'Create the mailbox
Conn.Execute "INSERT INTO mailbox (redirectaddress, redirectstatus, status, sizelimit, size, postoffice, mailbox) SELECT '', 0, 1, 40960, 0, '" & Session("domain") & "', '" & sMBX & "'"
'This line would not let me set the password using the encryption so I opted for the ME way of doing things
'Conn.Execute "INSERT INTO auth (status, rights, description, account, username, password) SELECT 1, 'USER', '', '" & Session("domain") & "', '" & sMBX & "@" & Session("domain") & "'"
Set oObject = Server.CreateObject("MEAOAU.Login") 'Create a var for making an auth
oObject.Account = Session("domain") 'I like to put thier domain (postoffice) in Session, that way I know it cannot be changed
oObject.Description = "" 'I havent seen ME use this descript
oObject.Password = sTemp 'The password from above
oObject.Rights = "USER" 'Since we built our own interface, lets make everyone non privledged
oObject.Status = 1 'Login Enabled
oObject.UserName = sMBX & "@" & Session("domain") 'The username (full email address)
oObject.AddLogin() 'Create the login (same as INSERT script above but has the password hashing thing that ME uses)
Set oObject = Nothing 'Again, it's nice to cleanup!
Set oObject = Server.CreateObject("Scripting.FileSystemObject") 'Reuse our var so we can make some files
'See if the postoffice is there, if so, create a root for the new user
If oObject.FolderExists("x:\mail\Postoffices\" & Session("domain") & "\MAILROOT\") Then oObject.CreateFolder "x:\mail\Postoffices\" & Session("domain") & "\MAILROOT\" & sMBX
'See if the root for the new user is there, if so, create an inbox for them
If oObject.FolderExists("x:\mail\Postoffices\" & Session("domain") & "\MAILROOT\" & sMBX) Then oObject.CreateFolder "x:\mail\Postoffices\" & Session("domain") & "\MAILROOT\" & sMBX & "\Inbox"
Set oObject = Nothing 'Again, it's nice to cleanup!
Case 2 'Group
Conn.Execute "INSERT INTO po_group (groupfile, groupstatus, recipientaddress, postoffice, groupname) SELECT '', 1, '[SF:" & Session("domain") & "/" & sMBX & "]', '" & Session("domain") & "', '" & sMBX & "'"
For j = LBound(sTemp) To UBound(sTemp) 'Lets loop through that carefully constructed array and add those members
Conn.Execute "INSERT INTO group_member (address, postoffice, mailbox) SELECT '[SMTP:" & sTemp(j) & "]', '" & Session("domain") & "', '" & sMBX & "'"
Next
End Select
'Create an address map for the new user / alias
Conn.Execute "INSERT INTO address_map (scope, status, account, sourceaddress, destinationaddress) SELECT '', 0, '" & Session("domain") & "', '[SMTP:" & sMBX & "@" & Session("domain") & "]', '[SF:" & Session("domain") & "/" & sMBX & "]'"
If Request("catch") = "1" Then 'Checks to see if they wanted this account to be a catchall
'We told them that checking the "make this account the catchall" would remove the other catchall, this is where we nuke the old one
Conn.Execute "DELETE FROM address_map WHERE account = '" & Session("domain") & "' AND sourceaddress = '[SMTP:*@" & Session("domain") & "]'"
'This is where we create the new catchall
Conn.Execute "INSERT INTO address_map (scope, status, account, sourceaddress, destinationaddress) SELECT '', 0, '" & Session("domain") & "', '[SMTP:*@" & Session("domain") & "]', '[SF:" & Session("domain") & "/" & sMBX & "]'"
End If
End If
Conn.Close 'I can't stress enough about cleaning up
Set rs = Nothing
Set Conn = Nothing
Response.Redirect("/admin/mail.asp") 'Get us back to the main mail screen so they can see thier new user / alias
%>