URAMIRAIKAN

1020のなれの果て (since 2005.6.19)

Active Directory ユーザーにパスワード更新期限をメール通知する

 Active Directoryでパスワードの有効期限を設定している場合、更新期限になると右下のバルーンで通知されます(WinXPやWin7想定)。
 ただ、PCの使用頻度が少ないユーザーとかはこの通知を見逃してしまうらしく、メールで通知できないか相談を受けました。

 そこで、対象の環境がWindows Server 2003ということもあって、今更感のあるVBScriptで対応することにしました。
 (来年のサポート終了までに移行する気はあるのだろうか?)

 要件は以下の通り。

  • パスワード期限が近付くとユーザーにメールで知らせる。
  • Administratorなど管理アカウントは除外する。
  • メールアドレスはADに登録していることが前提だが、未登録の場合は管理者に通知する。
  • メールサーバは一般的なSMTPサーバを使用(SMTP認証あり)
  • 一日一回程度の間隔で実行(これはタスクスケジューラで実行)

 念のため、使用者に設定を任せる部分は外部ファイルに分けてみました。

■メインスクリプト : pwnotify.vbs

Option Explicit On Error Resume Next Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000 Dim cmdResult, strLogFile, strLine, strCmd, strUser, intUAC, strMailBody, i, j Dim objShell, objFS, objFile, objUser Dim arrUsers, intMaxPwdDays, dtmExpDay, intVal, MailTo Set objShell = WScript.CreateObject("WScript.Shell") Set objFS = WScript.CreateObject("Scripting.FileSystemObject") objShell.CurrentDirectory = objFS.GetParentFolderName(WScript.ScriptFullName) '外部ファイルの読み込み ExecuteGlobal objFS.OpenTextFile(".\config.vbs").ReadAll 'ログファイル初期化 strLogFile = "pwnotify.csv" objFS.CreateTextFile strLogFile, True Set objFile = objFS.OpenTextFile(strLogFile, 2) objFile.WriteLine "DateTime : " & Now objFile.WriteLine "User,E-Mail,PasswordLastChanged,ExpirationDate,Status" objFile.Close 'Main Routine 'ユーザーのLDAPパス取得 arrUsers = Split(GetLdapPaths(Domain), ";") 'パスワード期限のチェック For Each strUser In arrUsers Set objUser = GetObject(strUser) intUAC = objUser.Get("userAccountControl") If intUAC And ADS_UF_DONT_EXPIRE_PASSWD Then '無期限ユーザーの処理 strLine = objUser.sAMAccountName & "," & objUser.mail & "," & objUser.PasswordLastChanged & ",None,Permanent" Else intMaxPwdDays = GetMaxPwdDays(Domain) dtmExpDay = DateAdd("d", intMaxPwdDays, objUser.PasswordLastChanged) intVal = intMaxPwdDays - Int(Now - objUser.PasswordLastChanged) '期限切れユーザーへメール送信 If CheckExcludeUser(objUser.sAMAccountName, ExcludeUser) Then '除外ユーザーの処理 strLine = objUser.sAMAccountName & "," & objUser.mail & "," & objUser.PasswordLastChanged & "," & dtmExpDay & ",Exclusion" Else If intVal <= NotifyLimit Then 'メール送信対象ユーザーの処理 strMailBody = "To: " & objUser.sAMAccountName & Chr(13) & Chr(10) & Chr(13) & Chr(10) & "Windowsのパスワード更新期限まで、あと" & intVal & "日です。" & Chr(13) & Chr(10) & "期限までにパスワードを変更してください。" If Len(objUser.mail) = 0 Then MailTo = DefaultTo Else MailTo = objUser.mail & "," & DefaultTo End If 'メール送信実行 cmdResult = SendMsg(SmtpServer, SmtpUser, SmtpPassword, MailFrom, MailTo, MailSubject, strMailBody) If cmdResult Then strLine = objUser.sAMAccountName & "," & objUser.mail & "," & objUser.PasswordLastChanged & "," & dtmExpDay & ",Send Mail" Else strLine = objUser.sAMAccountName & "," & objUser.mail & "," & objUser.PasswordLastChanged & "," & dtmExpDay & ",Send Error" End If Else 'メール送信対象外ユーザーの処理 strLine = objUser.sAMAccountName & "," & objUser.mail & "," & objUser.PasswordLastChanged & "," & dtmExpDay & ",Not Expired" End If End If End If Set objFile = objFS.OpenTextFile(strLogFile, 8) objFile.WriteLine strLine objFile.Close Next WScript.Quit(0) 'Sub Routine Function GetLdapPaths(Fqdn) Dim objConn, objCmd, objRecSet Dim arrDn, strDn, strPathLine, n arrDn = Split(Fqdn, ".") For n = 0 To UBound(arrDn) If n = 0 Then strDn = "DC=" & arrDn(n) Else strDn = strDn & ",DC=" & arrDn(n) End If Next Set objConn = CreateObject("ADODB.Connection") Set objCmd = CreateObject("ADODB.Command") objConn.Provider = "ADsDSOObject" objConn.Open "Active Directory Provider" objCmd.ActiveConnection = objConn '接続プロパティ objCmd.Properties("Page Size") = 1000 objCmd.Properties("Timeout") = 30 objCmd.Properties("Searchscope") = 5 objCmd.Properties("Cache Results") = False objCmd.CommandText = "SELECT AdsPath FROM 'LDAP://" & strDn & "' WHERE objectCategory='user'" Set objRecSet = objCmd.Execute objRecSet.MoveFirst strPathLine = objRecSet.Fields("AdsPath").Value objRecSet.MoveNext Do Until objRecSet.EOF strPathLine = strPathLine & ";" & objRecSet.Fields("AdsPath").Value objRecSet.MoveNext Loop objConn.Close Set objCmd = Nothing GetLdapPaths = strPathLine End Function 'パスワード有効日数(ドメインポリシー) Function GetMaxPwdDays(Fqdn) Dim objDom, objMaxPwdAge Dim arrDn, strDn, maxPwdNano, maxPwdSecs, n arrDn = Split(Fqdn, ".") For n = 0 To UBound(arrDn) If n = 0 Then strDn = "DC=" & arrDn(n) Else strDn = strDn & ",DC=" & arrDn(n) End If Next Set objDom = GetObject("LDAP://" & strDn) Set objMaxPwdAge = objDom.Get("maxPwdAge") GetMaxPwdDays = CCur((objMaxPwdAge.HighPart * 2 ^ 32) + objMaxPwdAge.LowPart) / CCur(-864000000000) Set objDom = Nothing End Function '除外ユーザー判定 Function CheckExcludeUser(TargetUser,ExcludeList) Dim arrExcludeUsers, tmpUser CheckExcludeUser = False arrExcludeUsers = Split(ExcludeList, ";") For Each tmpUser In arrExcludeUsers If LCase(tmpUser) = LCase(TargetUser) Then CheckExcludeUser = True Exit For End If Next End Function 'メール送信 Function SendMsg(strSmtp, strSmtpUser, strSmtpPass, strFrom, strTo, strSubject, strBody) Dim objMsg, strSchem, intPort, bolSmtpAuth strSchem = "http://schemas.microsoft.com/cdo/configuration/" intPort = 25 bolSmtpAuth = True Set objMsg = CreateObject("CDO.Message") 'SMTP認証を使用する場合 If bolSmtpAuth Then objMsg.Configuration.Fields.Item(strSchem & "sendusername") = strSmtpUser objMsg.Configuration.Fields.Item(strSchem & "sendpassword") = strSmtpPass objMsg.Configuration.Fields.Item(strSchem & "smtpauthenticate") = 1 'SMTP over SSLを使用する場合 'objMsg.Configuration.Fields.Item(strSchem & "smtpusessl") = True End If 'アドレス情報定義 objMsg.From = strFrom objMsg.To = strTo 'objMsg.Cc = strCc 'objMsg.Bcc = strBcc '件名/本文定義/添付ファイル objMsg.Subject = strSubject objMsg.TextBody = strBody objMsg.TextBodyPart.Charset = "ISO-2022-JP" '添付ファイル 'objMsg.AddAttachment(strAttacheFile) 'SMTPサーバ定義 objMsg.Configuration.Fields.Item(strSchem & "sendusing") = 2 objMsg.Configuration.Fields.Item(strSchem & "smtpserver") = strSmtp objMsg.Configuration.Fields.Item(strSchem & "smtpserverport") = intPort 'メール送信 objMsg.Configuration.Fields.Update objMsg.Send If Err.Number = 0 or Err.Number = -2147463155 Then SendMsg = True Else SendMsg = False End If End Function

■外部ファイル : config.vbs

'設定ファイル 'ドメイン名 Const Domain = "example.com" 'パスワード変更通知期限(この日数以下になるとユーザーへ通知します) Const NotifyLimit = 7 'メール送信設定 'SMTPサーバ Const SmtpServer = "smtp.example.com" '送信元メールアドレス(From) Const MailFrom = "admin@example.com" 'メール件名 Const MailSubJect = "[重要] パスワードを更新してください" '既定のメールアドレス(ユーザーのメールアドレスが未登録の場合はこのアドレスへ通知) Const DefaultTo = "postmaster@example.com" 'SMTP認証情報 Const SmtpUser = "postmaster" Const SmtpPassword = "password" '除外ユーザー(セミコロン区切りでユーザー名を記載) Const ExcludeUser = "Administrator;krbtgt"

 過去に作ったものから使い回している部分が多くまとまりがないので、そのうちブラッシュアップします。


    1 2 3 4 5
6 7 8 9 10 11 12
13 14 15 16 17 18 19
20 21 22 23 24 25 26
27 28 29 30 31    

プロフィール

1020@管理人

都内を彷徨っているインフラエンジニアとかいう雑用係。いつだって眠い…。

最近のつぶやき

@umkn1020 (07/06-17:56)
RT @sksat_tty: これは暴言ですが,Macで開発便利っつってるやつがGitリポジトリに.DS_Store入れてたら市中引き回しにして十字架に張り付けて火つける
@umkn1020 (07/03-18:57)
RT @kamo_hiroyasu: 「人口の1割は複文が処理できないのだから、そのつもりで行動しろ」と助言することが時々あるのですが、「何もしなければ、42万人死亡する」を「42万人死亡する」と誤読して「外した」と煽る人がわらわらと湧いてきたことで、説得力が増しました。
@umkn1020 (07/03-18:49)
RT @taijijiji: 外資企業が日本市場でhiring難しいとは聞いていましたがこれほどとは。。日本人の転職の心理的ハードルの高さ、英語ポジションへの苦手意識が伺える。。英語は実質的な語学スキルよりも「やっていける自信がない」「怖い」「どうせ落とされる」というメンタリテ…
@umkn1020 (07/03-13:03)
RT @yuutosi_hiyuu: 声だして笑った https://t.co/EjqAUuT3z0
@umkn1020 (07/02-16:02)
Smart LifeでIFTTT使えなくなっていたのか…

エントリーリスト

カテゴリーリスト

タグ