Michael's meanderings...

Finding Services Using non-System accounts

I went into a new customer recently and found that they had about a gazillion standalone servers, all of which had the same administrator password, and they used the Administrator account to run some services.

While there oftem seem to be good reasons for doing this (pass through authentication, only requiring a single account having elevated privileges, etc.) it almost always turns out to be a bad idea. It makes it difficult to change passwords when employees turn over, and you can have service failures when you change passwords.

And, lest you forget, there are other things that could possibly depend on these passwords too: COM objects and websites, to mention two other possibilities.

So, I wrote a script that, based upon a simple input file containing a list of computers, goes out and checks for all services running on each computer that are using a non-default account. For the purposes of my script, I considered these accounts to be default accounts: "NT AUTHORITY\LocalService", "LocalSystem",   ".\ASPNET",  "NT AUTHORITY\NETWORK SERVICE",  "NT AUTHORITY\NetworkService". In your environment, those will probably work, but I make no guarantees for that. :-)

This script also specifically identifies the total number of services running under the administrator account. Those are things you really probably want to change!

The input file is easy to generate from adfind/dsquery/dns - whatever way you can use to produce a list of servers in your environment, one server per line. If you need to have comment lines, then begin a line with the crosshatch character (”#”).

Sample summary output:

Processing complete
Total computers processed: 33
Total Administrator services: 27
Total special services: 62
Total errors: 0
Total comment lines: 0

Of course, as always, this script is provided “AS IS” and conveys no warranties.

Option Explicit
' check-services.vbs

Const ForReading = 1

Dim objFS, objFileIn, iCount, iError, iComment, iAdminCount, iTot
Dim strRemoteComputer

Sub e (str)
 WScript.Echo str
End Sub

Function ErrorReport (str)
 If Err.Number Then
  iError = iError + 1
  ErrorReport = True
  e "Error 0x" & CStr (Hex (Err.Number)) & " occurred " & str
  If Err.Description <> "" Then
                 e "Error description: " & Err.Description & "."
  End If
  Err.Clear
 Else
  ErrorReport = False
 End If
End Function

Sub Startup
 If Wscript.Arguments.Count <> 1 Then
  e "Usage: Check-Services.vbs listofcomputers.txt"
  e " "
  e "'listofcomputers.txt' contains a list of the computers"
  e "that will be checked for services that do not contain"
  e "default accounts."
  e " "
  wscript.quit 1
 End If

 On Error Resume Next

 Set objFS = CreateObject ("Scripting.FileSystemObject")
 If ErrorReport ("while creating Scripting.FileSystemObject") Then
  wscript.quit 1
 End If

 Set objFileIn = objFS.OpenTextFile (wscript.arguments (0), ForReading)
 If ErrorReport ("while opening " & wscript.arguments (0)) Then
  Set objFS = Nothing
  wscript.quit 1
 End If

 iTot = 0
 iCount = 0
 iError = 0
 iComment = 0
 iAdminCount = 0
End Sub

Sub Shutdown
 objFileIn.Close
 Set objFileIn = Nothing

 Set objFS = Nothing
End Sub

' Constants we need for WBEM calls
Const wbemFlagReturnImmediately = &H10
Const wbemFlagForwardOnly       = &H20

Dim arrExclude

arrExclude = Array ("NT AUTHORITY\LocalService", _
      "LocalSystem", _
      ".\ASPNET", _
      "NT AUTHORITY\NETWORK SERVICE", _
      "NT AUTHORITY\NetworkService")

Function CheckExclusions (ByVal strVal)
 Dim i

 For i = LBound (arrExclude) To UBound (arrExclude)
  If LCase (strVal) = LCase (arrExclude (i)) Then
   CheckExclusions = True
   Exit Function
  End If
 Next

 CheckExclusions = False
End Function
     
Sub CheckServicesOnComputer (ByVal strComputer)
 Dim objWMIService
 Dim colItems, objItem
 Dim iExcluded, iIncluded

 iExcluded = 0
 iIncluded = 0

 WScript.Echo ""
 WScript.Echo "Checking computer " & strComputer

 On Error Resume Next
 Set objWMIService = GetObject ("winmgmts:\\" & strComputer & "\root\CIMV2")
 If ErrorReport ("opening CIMv2") Then Exit Sub
 Set colItems = objWMIService.ExecQuery ("SELECT name,startname,caption FROM Win32_Service", "WQL", _
  wbemFlagReturnImmediately + wbemFlagForwardOnly)
 If ErrorReport ("on ExecQuery") Then Exit Sub
 On Error Goto 0

 ' if we get any items returned, it's installed
 For Each objItem In colItems
  If CheckExclusions (objItem.StartName) Then
   iExcluded = iExcluded + 1
  Else
   iIncluded = iIncluded + 1
   If Right (LCase (objItem.StartName), Len ("\Administrator")) = "\administrator" Then iAdminCount = iAdminCount + 1
   'wscript.echo "name = " & objItem.Name & " startname = " & objItem.StartName & " caption = " & objItem.Caption
   e " startname = " & objItem.StartName & " caption = " & objItem.Caption
  End If
 Next

 Set colItems = Nothing
 Set objWMIService = Nothing

 Wscript.echo "Included items = " & iIncluded & " excluded items = " & iExcluded & " for computer " & strComputer
 iTot = iTot + iIncluded
End Sub

 ' Main

 Call Startup
 Do Until objFileIn.AtEndOfStream
  strRemoteComputer = objFileIn.ReadLine
  If ErrorReport ("while reading input line") Then
   Exit Do
  End If

  ' If the first character is a "#", then the line is a comment
  If Left (strRemoteComputer, 1) <> "#" Then
   Call CheckServicesOnComputer (strRemoteComputer)
   iCount = iCount + 1
  Else
   iComment = iComment + 1
  End If
 Loop

 Call Shutdown

 e " "
 e "Processing complete"
 e "Total computers processed: " & iCount
 e "Total Administrator services: " & iAdminCount
 e "Total special services: " & iTot
 e "Total errors: " & iError
 e "Total comment lines: " & iComment

posted @ 11:28 AM

Comments Disabled

Unfortunately, due to the volume of blog spam I've been receiving, I've had to disable comments. When I can upgrade to a more recent version of Community Server, I'll reenable them at that time.

posted @ 2:09 PM

Exchange 200x Catchall Script, Version 2

I've been promising an update to my Exchange Catchall script, since almost the week it was first released.

The number one request has always been for it to handle more domains (the original version only handled two, and changing it to handle more was beyond the scripting skills of most folks).

The second most common request was to allow multiple copies of the script to run (usually because of the number one request). While that can be done by using multiple SMTP virtual servers, I don't recommend it. With this update, it shouldn't ever be necessary.

Philosophically, the days of catchall mailboxes are probably numbered. Many messaging experts recommend against them. Once a domain is targeted, a directory harvesting attack can cause catchall mailboxes to get slammed with thousands of messages in a very short period of time. Many mail systems now return an error, or drop the SMTP connection, or refuse connections from SMTP servers that send email to invalid addresses. (Exchange could be fairly easily extended to do those things, but it would require a protocol sink, not an event sink.)

However, many folks still want a catchall mailbox. Most mail servers other than Exchange support them in the base product. This is a nice simple implementation of one and this version supports an arbitrary number of domains.

The original version was tested on both Exchange 2000 Server and Exchange Server 2003. I no longer have an Exchange 2000 Server to test on, but none of the interface layer changed in this update, so the new version should still work on both versions of Exchange.

You can download the Exchange 200x Catchall Script, Version 2, here.

I am not aware of any other free tool that performs this function for multiple domains (Mailbasket Lite from http://turbogeeks.com will do it for a single domain).

Enjoy!

posted @ 10:45 AM

Outlook POP3 Timeout Annoyances

A number of folks have been running into Outlook 2003 POP3 problems, where either Outlook hangs or generates a timeout.

It is pretty obvious that there was an undocumented change in Exchange 2003 service pack 2 about the handling of POP3 messages. To read the relevant KB articles, the issues have been there for quite a while, but SP2 seems to exacerbate them...or it's all a coincidence. :-)

First of all, please ensure that you have Outlook 2003 service pack 2 installed. That fixes some of the recent issues.

Second, if you are using S/POP (POP3 with SSL), try KB 827349. Even though this KB only refers to Outlook 2002, it also applies to Outlook 2003.

Finally, try the registry change described in KB 816896. Note that this change has to be made on your Exchange server and requires, at a minimum, a POP3SVC restart.

posted @ 3:27 PM

Diagnosing SSL Problems and Importing Apache SSL Keys into IIS

posted @ 2:52 PM

Converting an Escaped Hex String to a Regular Hexadecimal String

I've shown a number of routines for dealing with hexadecimal numbers and byte arrays. One that I haven't yet shown is taking an escaped hex string and converting it to a regular hex string.

An escaped hex string is kind of a bastardized format - it uses regular characters when they can easily be represented in the local character set (like using '0' for 0x30 instead of \30). The escaping allows you to represent “special” characters. You see this quite a bit when dealing with GUIDs and with non-English names.

For a list of characters that must be escaped when constructing LDAP queries, see ADSI:Search Filter Syntax in MSDN.

The format of an escaped hex string is a backslash character “\” followed by the two hexadecimal digits for the character. Or a single character which is converted to its hex value when the string is converted (or not - it depends on the use of the string).

Here is a small program that shows you how to convert them:

' example escaped hex string (this is a GUID)
Const EscapedString = "\AB\95s\F5\F2\02DK\A2\CF\E5\07\A9\96q\EA"

wscript.echo "Escaped string: " & EscapedString

ResultString = ConvertEscapedToHex (EscapedString)

wscript.echo "Result string: " & ResultString
Wscript.echo "Length = " & Len (Resultstring) & " chars"

wscript.quit 0

Function ConvertEscapedToHex (str)
'
' take an escaped hex string and turn it into a fully hex string
'
 Dim i, j, newstr

 newstr = ""

 While Len (str) > 0
  If Left (str, 1) = "\" Then
   newstr = newstr & Mid (str, 2, 2)
   str = Right (str, Len (str) - 3)
  Else
   i = Asc (str)
   newstr = newstr & Right ("0" & Hex (i), 2)
   str = Right (str, Len (str) - 1)
  End If
 Wend

 ConvertEscapedToHex = newstr
End Function

posted @ 8:13 AM

Preventing users from using the dumpster in Outlook

I don't know that I would ever do this, but I thought the solution was pretty cool.

If you have a situation where you want to prevent users from using Deleted Item Recovery in Outlook, you have a mechanism for preventing them from doing so. However, a savvy user can still go to Outlook Web Access. But it takes a VERY smart user to figure out how to do Deleted Item Recovery from OWA for anything but the default Deleted Items folders.

But you, the administrator, can still do Deleted Item Recovery for the user. As noted, doing this makes more work for you - the Exchange administrator. But in a control-heavy environment it might be worth it.

This information came from: Nikki Peterson - EGOVX [NikkiPeterson@mail.maricopa.gov].

How to disable an Outlook user’s ability to "Recover Deleted Items":
- Exit and Logoff from Outlook
- Delete the file [c:]\Program Files\Microsoft Office\Office\Addins\dumpster.ecf
- Restart Outlook

NOTE: If you receive an error on startup, go to the ADD-INS section of outlook, and remove the check mark from the Recover Deleted Items option.

How to undo or re-enable an Outlook user’s ability to "Recover Deleted Items":
- Exit and Logoff from Outlook
- Copy the file dumpster.ecf to [c:]\Program Files\Microsoft Office\Office\Addins
- From ADD-INS, select INSTALL, and select dumpster.ecf

posted @ 10:44 PM

Sending an e-mail to users whose password is about to expire

This has come up a number of times, and I actually thought I'd blogged about it in the past -- but I guess not.

If you have users that only use POP and/or IMAP, and never log into via Outlook/Exchange or OWA Premium, then those users do not get notified when their password is about to expire.

You can write a script that sends your users e-mail when their passwords are about to expire. The script below is based on a Scripting Clinic article available here, with some bug fixes and enhancements.

This script, with a few changes and enhancements, is also in my upcoming book from O'Reilly: “Essential Exchange Server 2003“.

'
' exch-pwd-expires.vbs
'
' Michael B. Smith
' March 21, 2005
'
' This program scans all users in the Users container and all organizational units
' beneath the HOSTING_OU organizational unit, for users whose passwords have either
' already expired or will expire within DAYS_FOR_EMAIL days.
'
' An email is sent, using CDO, via the SMTP server specified as SMTP_SERVER to the
' user to tell them to change their password. You should change strFrom to match
' the email address of the administrator responsible for password changes.
'
' You will, at a minimum, need to change the SMTP_SERVER, the HOSTING_OU, and the
' STRFROM constants. If you run this on an Exchange server, then SMTP_SERVER can
' be "127.0.0.1" - and it may be either an ip address or a resolvable name.
'
' If you don't have an OU containing sub-OU's to scan, then set HOSTING_OU to the
' empty string ("").
'

 Option Explicit

 ' Per environment constants - you should change these!
 Const HOSTING_OU  = "Hosting"
 Const SMTP_SERVER  = "127.0.0.1"
 Const STRFROM   = "emailadmin@your.domain"
 Const DAYS_FOR_EMAIL  = 15

 ' System Constants - do not change
 Const ONE_HUNDRED_NANOSECOND    = .000000100   ' .000000100 is equal to 10^-7
 Const SECONDS_IN_DAY            = 86400
 Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
 Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D

 ' Change to "True" for extensive debugging output
 Const bDebug   = False

 Dim objRoot
 Dim numDays, iResult
 Dim strDomainDN
 Dim objContainer, objSub

 Set objRoot = GetObject ("LDAP://RootDSE")
 strDomainDN = objRoot.Get ("defaultNamingContext")
 Set objRoot = Nothing

 numdays = GetMaximumPasswordAge (strDomainDN)
 dp "Maximum Password Age: " & numDays

 If numDays > 0 Then

  Set objContainer = GetObject ("LDAP://CN=Users," & strDomainDN)
  Call ProcessFolder (objContainer, numDays)
  Set objContainer = Nothing

  If Len (HOSTING_OU) > 0 Then
   Set objContainer = GetObject ("LDAP://OU=" & HOSTING_OU & "," & strDomainDN)

   For each objSub in objContainer
    Call ProcessFolder (objSub, numDays)
   Next

   Set objContainer = Nothing
  End If

  '========================================
  ' Add the number of days to the last time
  ' the password was set.
  '========================================
  'whenPasswordExpires = DateAdd ("d", numDays, oUser.PasswordLastChanged)

  'WScript.Echo "Password Last Changed: " & oUser.PasswordLastChanged
  'WScript.Echo "Password Expires On: " & whenPasswordExpires
 End If

 WScript.Echo "Done"

Function GetMaximumPasswordAge (ByVal strDomainDN)
 Dim objDomain, objMaxPwdAge
 Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays

 Set objDomain = GetObject("LDAP://" & strDomainDN)
 Set objMaxPWdAge = objDomain.maxPwdAge

 If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
  ' Maximum password age is set to 0 in the domain
  ' Therefore, passwords do not expire
  GetMaximumPasswordAge = 0
 Else
  dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
  dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
  dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
  GetMaximumPasswordAge = dblMaxPwdDays
 End If
End Function

Function UserIsExpired (objUser, iMaxAge, iDaysForEmail, iRes)
 Dim intUserAccountControl, dtmValue, intTimeInterval
 Dim strName

 On Error Resume Next
 Err.Clear

 strName = Mid (objUser.Name, 4)
 intUserAccountControl = objUser.Get ("userAccountControl")

 If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
  dp "The password for " & strName & " does not expire."
  UserIsExpired = False
 Else
  iRes = 0
  dtmValue = objUser.PasswordLastChanged
  If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
   UserIsExpired = True
   dp "The password for " & strName & " has never been set."
  Else
   intTimeInterval = Int (Now - dtmValue)
   dp "The password for " & strName & " was last set on " & _
    DateValue(dtmValue) & " at " & TimeValue(dtmValue) & _
    " (" & intTimeInterval & " days ago)"

   If intTimeInterval >= iMaxAge Then
    dp "The password for " & strName & " has expired."
    UserIsExpired = True
   Else
    iRes = Int ((dtmValue + iMaxAge) - Now)
    dp "The password for " & strName & " will expire on " & _
     DateValue(dtmValue + iMaxAge) & " (" & _
     iRes & " days from today)."

    If iRes <= iDaysForEmail Then
     dp strName & " needs an email for password change"
     UserIsExpired = True
    Else
     dp strName & " does not need an email for password change"
     UserIsExpired = False
    End If
   End If

  End If
 End If
End Function

Sub ProcessFolder (objContainer, iMaxPwdAge)
 Dim objUser, iResult

 objContainer.Filter = Array ("User")

 Wscript.Echo "Checking company = " & Mid (objContainer.Name, 4)

 For each objUser in objContainer
  If Right (objUser.Name, 1) <> "$" Then
   If IsEmpty (objUser.Mail) or IsNull  (objUser.Mail) Then
    dp Mid (objUser.Name, 4) & " has no mailbox"
   Else
    If UserIsExpired (objUser, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
     wscript.Echo "...sending an email for " & objUser.Mail
     Call SendEmail (objUser, iResult)
    Else
     dp "...don't send an email"
    End If
   End If
  End If
 Next
End Sub

Sub SendEmail (objUser, iResult)
 Dim objMail

 Set objMail = CreateObject ("CDO.Message")

 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")      = 2
 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")     = SMTP_SERVER
 objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
 objMail.Configuration.Fields.Update

 objMail.From     = STRFROM
 objMail.To       = objUser.Mail

 objMail.Subject  = "Password needs to be set for " & Mid (objUser.Name, 4)
 objMail.Textbody = "The active directory password for user " & objUser.userPrincipalName & _
    " (" & objUser.sAMAccountName & ")" & vbCRLF & _
    "will expire in " & iResult & " days. " & vbCRLF & _
    "Please change it as soon as possible." & vbCRLF & vbCRLF & _
    "Thank you," & vbCRLF & _
    "Your email administrator"

 objMail.Send

 Set objMail = Nothing
End Sub

Sub dp (str)
 If bDebug Then
  WScript.Echo str
 End If
End Sub

posted @ 2:48 PM

Has adprep been run?

I had an interesting question asked of me today, and I had to spend some time looking into it, so I thought I'd share the result of that with you.

As you know, adprep is used for preparing Active Directory to include Windows Server 2003 domain controllers. It comes in two flavors:

adprep /forestprep

Which is, of course, run once per forest, and

adprep /domainprep

Which is, of course, run once per domain.

Forestprep

The forestprep process creates a new container named:

CN=Operations,CN=ForestUpdates,CN=Configuration,DC=ForestRootDomain

Each operation executed by adprep/forestprep causes a new GUID-named container object to be created in the above container.

If you are upgrading from any version of Windows 2000 Server to Windows Server 2003, and adprep/forestprep has completed successfully, then the CN=Operations container will have 36 of the GUID-name objects contained within it. If you are upgrading from a beta or release-candidate version of Windows Server 2003 to the released version, you may have as many as 43 of these objects.

If there are fewer than 36 objects, then adprep/forestprep failed somewhere along the process. You can compare the list of operations and GUIDs in the Microsoft KB article 309628.

Domainprep

Similar to forestprep, the domainprep operation also creates a new container:

CN=Operations,CN=DomainUpdates,CN=System,DC=DomainName

but unlike forestprep, domainprep also creates a second container:

CN=Windows2003Update,CN=DomainUpdates,CN=System,DC=DomainName

which contains a single attribute of interest CN=Revision.

The CN=Operations container will contain 50 updates (up to 55 if you are upgrading from beta-releases).

If all 50 of the operations are completed successfully, then the CN=Windows2003Update container will have its Revision attribute set to 8 (eight).

If the CN=Revision attribute is not eight, then each GUID in the CN=Operations,CN=DomainUpdates container may be examined to determine where adprep/domainprep failed. The list of these is also given in Microsoft KB article 309628.

Fun Fact

All of the non-schema updates that happen as a result of running adprep are executed on the domain controller which holds the infrastructure master FSMO role.

posted @ 12:34 PM

Using BackOfficeStorage/ExIFS

In Exchange Server 2003, Microsoft fixed the disaster that was the infamous “M:” drive, and hid it again. But the functionality was not removed -- lots of stuff depends on it.

ExIFS provides many capabilities, one of them is that the Exchange stores can be treated like a NTFS file system. You can open emails, scan mailboxes, etc. Do pretty much whatever you want to do -- except NEVER EVER EVER change a permission using the BackOfficeStorage/ExIFS interfaces (or Windows Explorer or any similar tool). Exchange and NTFS use the same bits in access control lists, but they mean different things. Just say no.

Here is an example piece of code that shows you how to treat the Exchange stores. This does assume that you've got full permission to examine your stores. I cover this material in Chapter 12 of my upcoming book.

'
Option Explicit
'
Dim objFSO, objFolder, objF
Dim bFirstEmail, iEmailCount
'
bFirstEmail = True
iEmailCount = 0
'
Set objFSO = CreateObject ("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder ("\\.\BackOfficeStorage")
'
For Each objF in objFolder.SubFolders
    'If bDebug Then wscript.echo "Checking folder " & objF.Path
    Call DoDirectory (objF, "")
Next
'
Set objFolder = Nothing
Set objFSO = Nothing
'
Sub DoDirectory (objFold, strIndent)
Dim objUserDir, objFile
'
WScript.Echo strIndent & "Checking Folder: " & objFold.Path
For Each objUserDir in objFold.SubFolders
    Call DoDirectory (objUserDir, strIndent & vbTab)
Next
'
For Each objFile in objFold.Files
    Wscript.echo strIndent & "Checking file: " & objFile.Path
    If bFirstEmail Then
        Dim objEmail, strLine
        '
        Set objEmail = objFSO.OpenTextFile (objFile.Path, 1)
        Do Until objEmail.AtEndOfStream
            strLine = objEmail.ReadLine
            WScript.Echo strline
        Loop
        objEmail.Close
        Set objEmail = Nothing
        bFirstEmail = False
    End If
    '
    iEmailCount = iEmailCount + 1
    If iEmailCount > 10 Then
        WScript.Echo "Done!"
        WScript.Quit 0
    End If
Next
End Sub

posted @ 9:35 AM