# Nothin in this directory should be cached
cd [Doc_Root]	;# so relative paths will be doc root relative
Doc_Dynamic

package require html
if {[llength [info proc ::html::stylesheet]] == 0} {
    proc ::html::stylesheet {href} {
	variable page
	lappend page(meta) "<link rel='stylesheet' type='text/css' href='$href'>"
	return ""
    }
}

namespace eval validation {
}
proc ::validation::genPasswd {password} {
    if {[catch {package require crypt}] || [catch {crypt foo ba}]} {
	# if we don't have a C library, fall back to pure tcl crypt
	package require tclcrypt
    }
    package require uuencode
    set crypt ":"
    while {[string match *:* $crypt]} {
	set crypt [crypt $password [Passgen_Salt]]
    }
    return $crypt
}

proc ::validation::chkPasswd {pass crypt} {
    if {[catch {package require crypt}] || [catch {crypt foo ba}]} {
	# if we don't have a C library, fall back to pure tcl crypt
	package require tclcrypt
    }
    set salt [string range $crypt 0 1]
    set crypt2 [crypt $pass $salt]
    if {[string compare $crypt $crypt2] != 0} {
	return 0	;# Not the right password
    } else {
	return 1	;# passwords matched
    }
}

proc ::validation::parseFile {file var {extra ""}} {
    upvar $var v
    if {$extra != ""} {
	upvar $extra e
    }
    
    # read the file
    catch {unset v}
    if {[catch {open $file a+} in]} {
	return $in
    }
    seek $in 0
    while {[gets $in line] >= 0} {
	if {[regexp {^[ \t]*#} $line]} {
	    continue
	}
	if {[regexp {^[ \t]*([^:]+)[ \t]*:[ \t]*([^:]+)(.*)$} $line x key value extra]} {
	    #append result "<p>[protect_text $line] [protect_text $key] [protect_text $value] [protect_text $extra]"
	    set v($key) [string trim $value]
	    set e($key) [string trim $extra]
	}
    }
    close $in
    return ""
}

proc validation::writefile {file var {extra ""}} {
    catch {
	upvar $var v
	if {$extra != ""} {
	    upvar $extra e
	} else {
	    set e() ""
	    unset e()
	}
	
	catch {
	    file copy -force $file ${file}~
	}
	
	set fd [open $file w]
	foreach {name val} [array get v] {
	    if {[info exists e($name)]} {
		puts $fd "${name}: $e($name)"
	    } else {
		puts $fd "${name}: $val"
	    }
	}
	
	close $fd
    } err
    Stderr $err
}

proc ::validation::debug {var} {
    upvar $var v
    if {[ncgi::value debug] == 1} {
	# debugging output
	return [subst {
	    <b>$var</b><br>
	    [html::tableFromArray v "border=1" *]
	    <p><b>CGI Values</b><br>
	    [html::tableFromList [ncgi::nvlist] "border=1"]
	    <p>
	    <b>Environment</b><br>
	    [html::tableFromArray ::env "border=1" *]
	}]
    }
}

proc get_AllowDeny {op} {
    foreach {v1 v2} [split [ncgi::value order_$op] ,] {break}
    return "[string totitle $v1],[string totitle $v2]"
}
 
proc MyAuthParseHtaccess {sock file {infoName ""}} {
    if {$infoName == ""} {
	upvar #0 auth$file info
	set infoName auth$file
    } else {
	upvar #0 $infoName info
    }
    
    set mtime [file mtime $file]
    if {![info exists info] || ($mtime > $info(htaccessp,mtime))} {
	# Parse .htaccess file
	foreach i [array names info "htaccessp*"] {
	    unset info($i)
	}
	set info(htaccessp,mtime) $mtime
	set info(htaccessp,userfile) {}
	set info(htaccessp,groupfile) {}
	if {[catch {open $file} in]} {
	    return 1
	}
	set state [list vars]
	foreach line [split [read $in] \n] {
	    #puts stderr "$state $line"
	    if {[regexp "^#" $line] || [string length [string trim $line]] == 0} {
		continue
	    }
	    if {[regexp <(.+)> $line x tag]} {
		#puts stderr "var tag $tag"
		set line $tag
	    }
	    set words [split $line]
	    set cmd [string tolower [lindex $words 0]]
	    if {[catch {
		#puts stderr "var eval Ht-$cmd $infoName [lrange $words 1 end]"
		eval Ht-$cmd $infoName [lrange $words 1 end]
	    } err]} {
		Log $sock Error $err
	    }
	}
	close $in
    }
    return 1
}

### Local Variables: ###
### mode:tcl ###
### End: ###
