Option Explicit
'-------------------------------------------------------------------------
' subversionacl
'
' Description:
' 
' Modifies an authorization.conf fro Apache to control subversion access
' Simply Updates the "[group]" section
' Permissions on svn path are untouched
'
' Runtime error are not controlled. So check, if the script runs correctly
' The script uses the permission of the calling User. Make sure that you have enough permissions
'
' (c)2006 Net at Work GmbH
'
' subversionacl autfilename groupdn groupdn groupdn groupdn ....
' Parameter 1  path and name of the authorization file
' Parameter 2..n  groupname.  can be dn or NT4 Style  domain\groupname
' 
' Version 1.0 (04. Feb 2005)
'		+ initial version
'-------------------------------------------------------------------------

' --------------------------------------------------------------
' You have to enther your values here !!!
' --------------------------------------------------------------

Const ForReading = 1
Const ForWriting = 2
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1


Dim strauthorization, strauthorizationfilename, strgroupdn, strNTName 
dim strOutFilePrefix, count, fso, fsoTextStream, objgroup, objUser, objMember, objTrans
dim strmemberlist

call ForceCScript  ' must be rund with CSCRIPT

' ----- Initialisierung der Debugging und Loggingoptionen
strOutFilePrefix = "grp2exinet-" & makefilename(Date() & "-" & Time()) ' complete file name für debug file
dim objDebug
set objdebug = new DebugWriter 
objDebug.target = "file:5 console:5 noie:0 noeventlog:0" ' errorlogging  0=only output, 1=Error 2=Warning 3=information  5++ =debug
objDebug.outFile = WScript.ScriptName & "-" & Date() & "-" & Time() & ".log"
objDebug.start
objDebug.writeln "grp2exinet: Started", 0


strauthorization = ""
strauthorizationfilename = ""

' parse commandline
' 
If (WScript.Arguments.length < 2 ) Then
	objDebug.writeln "commandlineerror:Please specify at minimum one group or User", 1
	WScript.quit(1)
End If

strauthorizationfilename = WScript.Arguments(0)
objDebug.writeln "Filename:" & strauthorizationfilename , 3

' read existing authorization file
Set fso = CreateObject("Scripting.FileSystemObject")
Set fsoTextStream = fso.OpenTextFile(strauthorizationfilename, ForReading)
strauthorization  = fsoTextStream.Readall
fsoTextStream.Close


'~ objDebug.writeln "Alt:" & strauthorization  , 3

Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""  ' Initialize NameTranslate by locating the Global Catalog.


for count = 1 to WScript.Arguments.length - 1
	strgroupdn = WScript.Arguments(count)
	objDebug.writeln "Processing Group:" & strgroupdn, 3
	if instr(strgroupdn,"cn") = 0 then
		objDebug.writeln "Convert NT4-Style top DN", 3
		objTrans.Set ADS_NAME_TYPE_NT4, replace(strgroupdn,"/","\")
		strgroupdn = objTrans.Get(ADS_NAME_TYPE_1779)  	' use the Get method to retrieve the RPC 1779 Distinguished Name.
		objDebug.writeln "got:" & strgroupdn , 3
	end if 

	objDebug.writeln "Bind Group: " & strgroupdn , 3
	Set objGroup = GetObject ("LDAP://"& strgroupdn)
	
	if isobject(objgroup) then 
		strmemberlist = ""
		Wscript.Echo vartype(objGroup.Member)
		For each objMember in objGroup.Member
			objDebug.writeln "Reading Members" , 3
			objTrans.Set ADS_NAME_TYPE_1779, objMember
			strNTName = objTrans.Get(ADS_NAME_TYPE_NT4)			' use the Get method to retrieve the NT Name.
			objDebug.writeln "Nametranslate: " & objMember & " -> " & strNTName , 4
			objDebug.writeln "Adding User:" & lcase(strNTName),4
			strmemberlist = strmemberlist & lcase(strNTName) & ", "
		Next
		if right(strmemberlist,2) = ", " then  ' Strip last comma
			strmemberlist = left(strmemberlist,len(strmemberlist)-1)
		end if 
		objDebug.writeln "Updating INI-Section" , 3
		strauthorization = UpdateINIString("groups", lcase(objgroup.samaccountname), strmemberlist, strauthorization)
	else
		objDebug.writeln "Unable to bind group" , 1
	end if 
next

' write Updates authorization file
objDebug.writeln "Writing file back to disk" , 3
Set fsoTextStream = fso.OpenTextFile(strauthorizationfilename, ForWriting)
fsoTextStream.Write strauthorization
fsoTextStream.Close
objDebug.writeln "Done- Quitting" , 3
wscript.quit(0)




sub ForceCScript
    If InStr(1,WScript.FullName,"cscript",vbTextCompare) = 0 Then   ' Prüfung ob mit CSCRIPT gestartet wurde
        wscript.echo "Bitte mit CSCRIPT aufrufen"
        wscript.quit (255)
	end if
end sub

class debugwriter
	' Generic Class für writing debugging information

	private objIE, file, fs, debugfilename, status, strline
	private debuglevelIE , debuglevelfile, debugleveleventlog, debuglevelConsole

	private Sub Class_Initialize
		status = "active" : strline = "" : debugfilename = ""
		debuglevelIE = -1
		debuglevelfile = -1 
		debugleveleventlog = -1
		debuglevelConsole = -1
	End Sub

	private Sub Class_Terminate()
		if isobject(OBJIE) then
			objie.document.write "</table></body></html>"
		end if
		if debugfilename <> "" then
			file.Close
		end if
	End Sub

	public sub start : status = "active": end sub
	public sub pause : status = "pause" : end sub

	public property let outfile(wert) 	
		if debugfilename <> "" then    'Close existing debug file
			file.close : file = nothing : fs = nothing 
		end if

		debugfilename = wert    ' open debug file
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set file = fs.OpenTextFile(makefilename(debugfilename), 8, True)
	end property

	public property let setie (wert)  : set objIE = wert  : objie.visible = true  end property

	public property let target (wert)
		dim arrTemp, intcount
		arrTemp = split(wert," ")  ' spit by space
		for intcount = 0 to ubound(arrTemp)
			select case lcase(split(arrtemp(intcount),":")(0))
				case "ie" 		debuglevelIE = cint(right(arrtemp(intcount),1))
				case "file" 	debuglevelfile = cint(right(arrtemp(intcount),1))
				case "eventlog" debugleveleventlog = cint(right(arrtemp(intcount),1))
				case "console" 	debuglevelConsole = cint(right(arrtemp(intcount),1))
			end select
		next
	end property

	sub write(strMessage)  
		strline = strline & strMessage
	end sub

	Sub writeln(strMessage, intseverity)
	'Fügt einen Eintrag in die Log-Datei ein
		strMessage = strline & strMessage
		if (status = "active") Then
           if (debuglevelfile >= intseverity) and (debugfilename <> "") then
                file.Write(Now & ",")
                Select Case intseverity
                    Case 0  file.Write("Out0")
                    Case 1  file.Write("Err1")
                    Case 2  file.Write("Wrn2")
                    Case 3  file.Write("Inf3")
                    Case Else file.Write("Dbg"&intseverity)
                End Select
                file.WriteLine("," & Convert2Text(strMessage))
            end if

           if debugleveleventlog >=intSeverity then
                dim objWSHShell
				Set objWSHShell = Wscript.CreateObject("Wscript.Shell")
                Select Case intseverity
                    Case 0  objWSHShell.LogEvent 0, strMessage '           		Const EVENT_SUCCESS = 0
                    Case 1  objWSHShell.LogEvent 1, strMessage '           		const EVENT_ERROR = 1
                    Case 2  objWSHShell.LogEvent 2, strMessage '           		Const EVENT_WARNING = 2
                    Case else  objWSHShell.LogEvent 4, strMessage '           		Const EVENT_INFO = 4
                End Select
           end if

           if debuglevelconsole >=intSeverity then
                Select Case intseverity
                    Case 0  wscript.echo now() & ",OUT0:" & strMessage
                    Case 1  wscript.echo now() & ",ERR1:" & strMessage
                    Case 2  wscript.echo now() & ",WRN2:" & strMessage
                    Case 3  wscript.echo now() & ",INF3:" & strMessage
                    Case Else wscript.echo now() & ",DBG" & intseverity & ":" & strMessage
                End Select

           end if

           if debuglevelie >=intSeverity then
           		dim strieline
      			if  not isobject(objIE) then
      				Set objIE = CreateObject("InternetExplorer.Application")
           		    objIE.navigate("about:blank")
					objIE.visible = true
					Do While objIE.Busy
				    	WScript.Sleep 50
					Loop
					objIE.document.write "<html><head><title>DebugWriter Output</title></head><body>"
					objIE.document.write "<div class=“table-responsive“><table  border=""1"" width=""100%""><tr><th>Time</th><th>intseverity</th><th>Description</th></tr>"
				end if
           		strieline = "<tr><td>" & now () & "</td>"
                Select Case intseverity
                    Case 0  strieline = strieLine & "<td bgcolor=""#00FF00"">Out0</td>"
                    Case 1  strieline = strieLine & "<td bgcolor=""#FF0000"">Err1</td>"
                    Case 2  strieline = strieLine & "<td bgcolor=""#FFFF00"">Wrn2</td>"
                    Case 3  strieline = strieLine & "<td>Inf3</td>"
                    Case Else strieline = strieLine & "<td>Dbg"&intseverity&"</td>"
                End Select
                strieline = strieline & "<td>" & strmessage & "</td></tr>"
				objIE.document.write cstr(strieline)
           end if

           '~ if (instr(DebugTarget,"mom") <>0) then
				'~ scriptContext.echo now() &","& intseverity &":"& strline & strMessage
           '~ end if

		end if  ' if status = active
		strline = ""
   	End Sub
	
	
	private function makefilename(wert)
		' Converts all invalid characters to valid file names
		wert = replace(wert,"\","-")
		wert = replace(wert,"/","-")
		wert = replace(wert,":","-")
		wert = replace(wert,"*","-")
		wert = replace(wert,"?","-")
		wert = replace(wert,"<","-")
		wert = replace(wert,"|","-")
		wert = replace(wert,"""","-")
		makefilename = wert
	end function
	
	private function Convert2Text(wert) 	' Converts non printable characters to "X" , so that Textfile is working
		dim loopcount, tempwert, inttest
		tempwert=""
		for loopcount = 1 to len(wert)   ' replace all unprintable characters  maybe easier and faster with RegEx
			tempwert = tempwert & chr(ascb(mid(wert,loopcount,1)))	
		next
		Convert2Text = tempwert
	end function
	
end class



function UpdateINIString(Section, KeyName, Value,INIContents)
  Dim PosSection, PosEndSection
  
  'Get contents of the INI file As a string

  'Find section
  PosSection = InStr(1, INIContents, "[" & Section & "]", vbTextCompare)
  If PosSection>0 Then
    'Section exists. Find end of section
    PosEndSection = InStr(PosSection, INIContents, vbCrLf & "[")
    '?Is this last section?
    If PosEndSection = 0 Then PosEndSection = Len(INIContents)+1
    
    'Separate section contents
    Dim OldsContents, NewsContents, Line
    Dim sKeyName, Found
    OldsContents = Mid(INIContents, PosSection, PosEndSection - PosSection)
    OldsContents = split(OldsContents, vbCrLf)

    'Temp variable To find a Key
    sKeyName = LCase(KeyName & "=")

    'Enumerate section lines
    für Each Line In OldsContents
      If LCase(Left(Line, Len(sKeyName))) = sKeyName Then
        Line = KeyName & "=" & Value
        Found = True
      End If
      NewsContents = NewsContents & Line & vbCrLf
    Next

    If isempty(Found) Then
      'key Not found - add it at the end of section
      NewsContents = NewsContents & KeyName & "=" & Value
    Else
      'remove last vbCrLf - the vbCrLf is at PosEndSection
      NewsContents = Left(NewsContents, Len(NewsContents) - 2)
    End If

    'Combine pre-section, new section And post-section data.
    INIContents = Left(INIContents, PosSection-1) & _
      NewsContents & Mid(INIContents, PosEndSection)
  else'if PosSection>0 Then
    'Section Not found. Add section data at the end of file contents.
    If Right(INIContents, 2) <> vbCrLf And Len(INIContents)>0 Then 
      INIContents = INIContents & vbCrLf 
    End If
    INIContents = INIContents & "[" & Section & "]" & vbCrLf & _
      KeyName & "=" & Value
  end if'if PosSection>0 Then
  UpdateINIString = INIContents
End function


function makefilename(byVal wert)
	' Converts all invalid characters to valid file names
	wert = replace(wert,"\","-")
	wert = replace(wert,"/","-")
	wert = replace(wert,":","-")
	wert = replace(wert,"*","-")
	wert = replace(wert,"?","-")
	wert = replace(wert,"<","-")
	wert = replace(wert,"|","-")
	wert = replace(wert,"""","-")
	makefilename = wert
end function