#!/usr/bin/tclsh

proc puts_array_html { fd array_name } {
	upvar $array_name array
	puts $fd <table>
	foreach { name value } [array get array] {
		puts $fd [format "<tr><td>%-30s</td><td>%s</td></tr>" $name $value]
	}
	puts $fd </table>
}

proc get_args { array_name } {
	upvar $array_name array

	if { ![info exists ::env(QUERY_STRING) ] } return

	foreach arg [split $::env(QUERY_STRING) "&"] {
		foreach { name value } [split $arg "="] {}
		set array([un% $name]) [un% $value]
	}
}

proc un% { str } {
	set l [string length $str]
	set s ""
	for { set i 0 } { $i<$l } { incr i } {
		set c [string index $str $i]
		if { $c=="%" } {
			set hex ""
			incr i
			append hex [string index $str $i]
			incr i
			append hex [string index $str $i]
			append s [format %c [expr 0x$hex&0xff]]
		} {
			append s $c
		}
	}
	set s
}

proc % { str } {
	set l [string length $str]
	set s ""
	for { set i 0 } { $i<$l } { incr i } {
		set c [string index $str $i]
		binary scan $c c1 v
		if { $v<0x30 || $v>=0x7f } {
			append s [format %%%02x [expr $v&0xff]]
		} {
			append s $c
		}
	}
	return $s
}

set args(file) .

get_args args


proc do_directory { file } {
	upvar stat stat

	puts stdout "Content-type: text/html"
	puts stdout ""

	puts stdout "<pre><table>"
	foreach file [lsort [glob *]] {
		file stat $file stat
		puts stdout "<tr><td>[clock format $stat(mtime) -format "%Y/%m/%d %H:%M:%S"]<td> $stat(size)<td> <a href='?file=$file'>$file</a>"
	}
	puts stdout "</table></pre>"
}

proc do_file { file } {
	upvar stat stat

	puts stdout "Content-type: text/plain"
	puts stdout ""

	set fd [open $file]
	fcopy $fd stdout
	close $fd
}

proc show { file } {
	set file [file normalize [pwd]/$file]
	if { ![string match [pwd]* $file] } {
		puts stdout "Content-type: text/plain"
		puts stdout ""
		puts stdout "pas bien !"
		return
	}

	if { [catch {
		file stat $file stat
		do_$stat(type) $file
	} why ] } {
		puts stdout "Content-type: text/plain"
		puts stdout ""
		puts stdout $why
	}
}

show $args(file)