

# Things we want to take into account
# - How to deal with ncluded files
# - How to deal with name based virtual hosts
# - How to deal with some directives being disabled

# Included file
#   - Up to a certain point included files are as if they were
#   in the same file, so we could in theory just process it as usual
# 
#   - Name based virtual hosts.
#     If we could deliver the parsing in chunks (list of lines) and return 
# in chunks, we could:  solve the virtual host stuff and also more easy for 
# saving Include files
#
#  Available vars:
#  currentXmlDirectives: List with all xmlDirectives 
#                 not yet dumped for the currentScope 
#  currentContainer: currentContainer
#  
#  currentContainerStack
#  xmlDirectivesStack     (to move up and down between sections)
#  
#  parseFile [split [read httpd.conf] \n]
#  parseFile $httpd.conf
#  
#  
# parseText --
#  
#  while [llength $lines] {
#      set data [getLine $lines]
#      set info [type $data]
#      
#      # info contains: {type extra_data}
#      
#      switch [lindex $info 1] {
#	 comment {
#	    append buffer
#	 } include {
#	    # needs to be defined
#	 } beginningOfSection {
#	    get all lines until end of section
#	    processSection
#	 } directive {
#	    processDirective
#	 }
#      }	 
#  }
#  
#
#  processDirective {} {
#      # Belongs to a disabled module?
#      #     yes -> return
#      #     no -> continue
#      # Exists specialCase?
#      # Exists entry in xmlDirectives?
#      # Exists unknown?
#      # If not, ignore it
#   
#  }  
      
  

class ::apachePrettyDumper {
    variable specialCaseMapping
    variable specialCaseDirectiveMapping
    variable currentXmlDirectives
    variable currentContainer
    variable currentContainerStack
    variable containerList
    variable containerListStack
    variable xmlDirectivesStack
    variable xmlConfDoc

    # need to know if directives enabled or not

    public variable moduleManager

    # For include files
    variable currentFile
    
    # In Apache all the includes are relative to serveroot, so we do not really need
    # currentFile

    public variable includeroot

    constructor {} {
	
	# Have to made them global, if inherited 
	# by sambaParser does not work

	set currentContainerStack [stack ::#auto]
	set xmlDirectivesStack [stack ::#auto]
	set containerListStack [stack ::#auto]
    }
    method parseText {lines} 
    method isSpecialCase 
    method setSpecialCase
    method setSpecialCaseDirectiveMapping
    method getLine
    method processDirective
    method processSection
    method getXmlDirectivesWithThatName
    method dumpDirective
    method dumpSpecialCase
    method dumpContainer
    method dump
    method dumpFile
    method dumpRest
    method getSection

    proc getTypeOfLine

}

body ::apachePrettyDumper::dump { xmlConfDocument fileName } {
    set xmlConfDoc $xmlConfDocument
    set currentContainer [$xmlConfDoc getRootContainer]
    set containerList [$xmlConfDoc getContainers $currentContainer]
    set currentXmlDirectives [$xmlConfDoc getDirectives $currentContainer] 
    set currentFile $fileName
    dumpFile $fileName 1
}

# Main tells if it is the main httpd.conf so anything that remains, 
# we dump there

body ::apachePrettyDumper::dumpFile { fileName {main 0}} {
    set currentFile $fileName
    set f [open $fileName r]
    set text [read $f]
    close $f
    set result [parseText [split $text \n ]]
    if $main {
	append result [dumpRest]
    }
    set f [open $fileName w]
    puts $f $result
    close $f
}

body ::apachePrettyDumper::parseText { lineList } {
    set result {}   
    while {[llength $lineList]} {
	set data [getLine lineList]
	set info [getTypeOfLine $data]

	# info contains: {type ?extra_data?}

	switch [lindex $info 0] {
	    comment {
		append result $data\n
	    } include {
		set includeFile [join [lindex $info 1]]
		set tmpFile $currentFile
		switch [file pathtype $includeFile] {
		    absolute {
			
			# Do nothing, we can open it
			
			$this dumpFile $includeFile 0
		    } relative {
			
			# Ok, we need to prepend the conf directives dir
			set includeFile [file join $includeroot $includeFile]
			if ![file exists $includeFile] {
			    puts "Include file $includeFile could not be processed. \
				    Check that it exists and has the right permissions"
			} else {
		   	   $this dumpFile $includeFile 0
		      	}
		    } volumerelative {
			
			# Um, unsure about what volume relative is.
			
			#puts "Include path was volume relative"
		    } default {
			error "Unknown path type"
		    }        
		}
		set currentFile $tmpFile
	    } beginSection {

		# sectionInfo = {value class}

		set sectionInfo [lrange $info 1 2]

		# Returns the lines belonging to the section and 
		# the rest

		set sectionResult [getSection $sectionInfo $lineList]
		foreach {section lineList} $sectionResult break;
		append result [processSection $sectionInfo $section]
	    } directive {
	        set textToAppend [processDirective $data]
	        switch -glob -- $textToAppend {
		    {} {}
		    {__comanche_default_directive__*} {
		       append result [lindex $textToAppend 1]\n
		    } default {
		       append result $textToAppend
		    }
		}
		
	    } default {
		error "Encountered unexpected $info $data $lineList"
	    }
	    
	}
     }

    return $result
}


# getSection --
#    We have detected the beginning of a section. Now we want to return the lines
# inside the section. It is necessary to abstract this interface, as Samba does not
# mark the end of a section.
#  
# sectionInfo 
# lineList 
#
# returns 
#    sectionLines : lines belonging to the section
#    rest:  rest of lines

body ::apachePrettyDumper::getSection {sectionInfo lineList} {
    set data [getLine lineList]
    set info [getTypeOfLine $data]
    set section {}
    set sectionLines {}
    # Only interested in endOfSection of same type, so we can anidate requests
    
    # We need to take into account recursive sections, like ifModule sections
    # Any time we encounter a section of the same type we are configuring, count increments
    # Any time we encounter a endSection we decrement
    # To get out of the loop count must be 0
    
    set sectionTypeMain [string tolower [lindex $sectionInfo 0]]
    set typeOfLine [string tolower [lindex $info 0]]
    set sectionType [string tolower [lindex $info 1]]
    set count 1
	if {[expr [string match $typeOfLine beginsection] && [string match $sectionTypeMain $sectionType]]} {
	    incr count
	}
	if {[expr [string match $typeOfLine endsection] && [string match $sectionTypeMain $sectionType ]]} {
	        incr count -1
	}    
    while {![expr [string match $typeOfLine endsection] \
	    && [ string match $sectionTypeMain $sectionType ] && !$count]} {
	lappend sectionLines $data
	set data [getLine lineList]
	set info [getTypeOfLine $data]
	
	# Directory / directory

	set sectionType [string tolower [lindex $info 1]]	
	set typeOfLine [string tolower [lindex $info 0]]

	if {[expr [string match $typeOfLine beginsection] && [string match $sectionTypeMain $sectionType]]} {
	    incr count
	}
	if {[expr [string match $typeOfLine endsection] && [string match $sectionTypeMain $sectionType ]]} {
	        incr count -1
	}
    }
    return [list $sectionLines $lineList ]
}

body ::apachePrettyDumper::dumpRest {} {
    #set result \n
    set result {}
    
    # Now we have left the ones that were not found in the template

    foreach directive $currentXmlDirectives {
	set dirName [string tolower [$directive getName]]
	# Skip disabled directives

	if ![$moduleManager isDirectiveEnabled $dirName] {
	    continue
	}  
	if [$directive doYouBelongTo unknownDirective] {
	    debug "dumping unknown in dumpRest $directive - [$directive getValue]"
	    append result [$directive getValue]\n
	} elseif [info exists specialCaseMapping($dirName)] {
	    set response [dumpSpecialCase $dirName $directive]
	    if ![regexp __comanche_default_directive__ $response] {
	       append result $response
	    }
	} else {
	    set response [dumpDirective $directive]
    	    if ![regexp __comanche_default_directive__ $response] {
	       append result $response
	    }
	}
    }

    # Same goes with containers

    foreach one $containerList {
	append result [dumpContainer $one]
	set idx [lsearch -exact $containerList $one]
	set containerList [lreplace $containerList $idx $idx]         	    
    }
    return $result
}

body ::apachePrettyDumper::dumpContainer {container} {
    set result {}
    set containerTagName [comanche::capitalize [$container getClasses]]
    set name [$container getName]
    if [string length $name] {
	append result "<$containerTagName $name>\n"
    } else {
	append result "<$containerTagName>\n"
    }
    foreach directive [$xmlConfDoc getDirectives $container] {
	set dirName [string tolower [$directive getName]]
	 if [$directive doYouBelongTo unknownDirective] {
	     append result [$directive getValue]\n
	 } elseif [info exists specialCaseMapping($dirName)] {
	     set res [dumpSpecialCase $dirName $directive]  
	     if [regexp __comanche_default_directive $res] {
		 append result [lindex $res 1]\n
	     } else {
		 append result $res
	     }
	} else {
	    set res [dumpDirective $directive]
	     if [regexp __comanche_default_directive $res] {
		 append result [lindex $res 1]\n
	     } else {
		 append result $res
	     }
	}     
    }
    foreach childContainer [$xmlConfDoc getContainers $container] {
	append result [ dumpContainer $childContainer]
    }
    append result "</$containerTagName>\n"  
    return $result
}

# sectionInfo is a list containing {value class}

body ::apachePrettyDumper::processSection {sectionInfo data} {
    
    set result {}
    set class [lindex $sectionInfo 0]
    set value [lindex $sectionInfo 1]


    # Save previous state

    $xmlDirectivesStack push $currentXmlDirectives
    $currentContainerStack push $currentContainer

    # Search for containers with same class and value
    #      How many?
    #          0 -> Do nothing
    #          1 -> Just use that one
    #          >1 -> Is a virtual host?
    #                check serverName
    #                    matches?
    #                    Yes: use that
    #                    none matches: forget

    set matchingContainers {}

    foreach one $containerList {
	set containerClass [string tolower [$one getClasses]]
	if ![string compare $containerClass $class] {
	    if  ![string compare [$one getName] $value] {
		lappend matchingContainers $one
	    }
	}
    }

    
    switch [llength $matchingContainers] {
	0 {
	    set processSection 0
	} 1 {
	    set matchingContainer $matchingContainers
	    set processSection 1
	} default {

	    # Keep sections in their original order, at least
	    # those taht cannot be modified directly from the interface
	    # IfModule, IfDefine

	    if [regexp (ifmodule|ifdefine) $class] {
	       set matchingContainer [lindex $matchingContainers 0]
		set processSection 1
	    } else {
		set processSection 0
	    }
	}
    }

    # Remove container from list
    
    if $processSection {
	set idx [lsearch -exact $containerList $matchingContainer]
	set containerList [lreplace $containerList $idx $idx]
	$containerListStack push $containerList
	set currentXmlDirectives \
		[$xmlConfDoc getDirectives $matchingContainer]
	set currentContainer $matchingContainer
	set containerList [$xmlConfDoc getContainers $matchingContainer]
	set containerTagName \
		[comanche::capitalize [$matchingContainer getClasses]]
	set name [$matchingContainer getName]
	if [string length $name] {
	    append result "<$containerTagName $name>\n"
	} else {
	    append result "<$containerTagName>\n"
	}
	append result [parseText $data]
	append result [dumpRest]
	append result "</$containerTagName>\n" 
	set containerList [$containerListStack pop]	    
    }

    set currentXmlDirectives [$xmlDirectivesStack pop]
    set currentContainer [$currentContainerStack pop]
    return $result
}

body ::apachePrettyDumper::getLine { lineList } {
    upvar $lineList list
    set result [lindex $list 0]
    set list [lrange $list 1 end]
    return $result
}

body ::apachePrettyDumper::getTypeOfLine { line } {
    set data [string trim $line]
    if {[regexp "^#+" $data] || ![string length $data]} {
	return comment
    } elseif [regexp -nocase {^include +(.*)} $data dummy fileName] {
	return [list include $fileName]
    } elseif [regexp "^</(.*)>+$" $data dummy class ] {
	return [list endSection $class]
    } elseif [regexp "^<+(.*)>+$" $data dummy tag] {
	if [regexp {<([^ ]*) (.*)>} $data dummy class value] {
	    return [list beginSection [string tolower $class] $value]
	} else {
	    return [list beginSection [string tolower $tag] {}]
	}
    } else {
	return directive
    }       

}

body ::apachePrettyDumper::processDirective {data} {

    set result {}

    # TODO: check if belongs to disabled module and return if so.
    
    set dirName [string tolower \
	    [lindex [set elements \
	    [ ::apacheparserutils::getElements $data ]] 0]]

    if [string match serverroot $dirName] {
	
	# join is necessary to handle spaces on Windows
	
	set includeroot [join [lindex $elements 1]]
    }       

    if ![$moduleManager isDirectiveEnabled $dirName] {
	return {}
    }

    if [ isSpecialCase $dirName ] {   

	set xuiDirectiveName [string tolower $specialCaseDirectiveMapping($dirName)]

	# check if currentXMLDirectives contains xuiDirective associated
	# with this special case

	if [llength [set xuiDirective [ getXmlDirectivesWithThatName $xuiDirectiveName ]]] {

	    # yes -> process it append to result
	    #        delete from currentXml
	    
	    set result [dumpSpecialCase $xuiDirectiveName $xuiDirective]
	    set idx [lsearch -exact $currentXmlDirectives $xuiDirective]
	    set currentXmlDirectives [lreplace $currentXmlDirectives $idx $idx]
	    return $result
	} else {

	    # no -> We already processed it return nothing

	    return {}
	}

    }

    if [llength [set list [ getXmlDirectivesWithThatName $dirName ]]] {
	
	# yes --> process it append to result
	#         delete from currentXmlDirectives

	# switch depending if unknown or not

	foreach one $list {
	    if [$one doYouBelongTo unknownDirective] {
		append result [$one getValue]\n
	    } else {
		append result [dumpDirective $one]
	    }
	    set idx [lsearch -exact $currentXmlDirectives $one]
	    set currentXmlDirectives [lreplace $currentXmlDirectives $idx $idx]         
	}
	return $result
    }
	
    
    # If we are here it was not found, so we ignore it

    return {}

}

body ::apachePrettyDumper::getXmlDirectivesWithThatName {dirName} {
    set result {}
    foreach one $currentXmlDirectives {
	if ![string compare [string tolower [$one getName]] $dirName] {
	    lappend result $one
	}
    }
    return $result
}

body ::apachePrettyDumper::dumpDirective {directive} {
    set result {}
    if [$directive doYouBelongTo unknownDirective] {
	set result "[$directive getValue]\n"
	return $result
    }
    set tagName [$directive getTagName]
    switch [$directive getXuiClass] {
	string - number  {
	    set value [$directive getValue]
	    if {[$directive doYouBelongTo file] || \
		    [$directive doYouBelongTo directory] || \
		    [$directive doYouBelongTo quoteIfSpace] } { 
		if [regexp {\ } $value] {
		    set value "\"$value\""
		}
	    }
	    if [string compare $value [$directive getDefault]] {
		append result "$tagName $value\n"
	    } else {
		return [list __comanche_default_directive__ $result]
	    }
	} boolean {
	    set value [$directive getValue]
	    switch $value {
		0 {
		    append result "$tagName off\n"
		} 1 {
		    append result "$tagName on\n"
		}
	    }
	    if ![string compare $value [$directive getDefault]] {
		return [list __comanche_default_directive__ $result]
	    }
	} choice {

	    # TO-DO: Check if it is multiple choice


	    append result \
		    "$tagName [$directive getSelected]\n"     
	    if ![string compare \
		    [$directive getSelected] [$directive getDefault]] {
		return [list __comanche_default_directive__ $result]
	    }
	} default {
	    error "No special case and not recognized in dumping\
		    [$directive getXuiClass] [$directive getName]"
	}
    }
    if ![string length [string trim $result]] {
	return {}
    } else {
	return $result
    }    
}
                   

body ::apachePrettyDumper::dumpSpecialCase {dirName directive} {
    set result [$specialCaseMapping($dirName) $directive] 
    if ![string length [string trim $result]] {
	return {}
    } else {
	return $result
    }
}

body ::apachePrettyDumper::isSpecialCase {dirName} {
    return [info exists specialCaseDirectiveMapping($dirName)]  
}

body ::apachePrettyDumper::setSpecialCase { procedure args } {

    # Maps xuiObjects -> procedures to dump them

    foreach xuiDirectiveName $args {
	set specialCaseMapping([string tolower $xuiDirectiveName]) \
		$procedure
    }
}

# Sets mapping between directives that are found in httpd.conf and their corresponding 
# xuiObject directive. Example, allow and deny httpd.conf directives map to access directive

body ::apachePrettyDumper::setSpecialCaseDirectiveMapping \
	{ xuiDirectiveName args } {
    foreach one $args {
	set specialCaseDirectiveMapping([string tolower $one]) \
		$xuiDirectiveName
    }

}

      
