#!/usr/bin/tcl

#vedi i commenti in testa a preq.tcl
# il main e' in fondo

proc subhex {v} {
    set nv $v
    while {[regexp {%[0-9A-F][0-9A-F]} $v blah]} {
	scan $blah "%%%x" cv
	if {[ctype char $cv]=="&"} {
	    regsub -all $blah $v \\& nv
	} else {
	    regsub -all $blah $v [ctype char $cv] nv
	}
	set v $nv
    }
    return $v
}

proc http_proc_cgi_args {} {
    global ar artype
    global env
    set bigarg ""
    #join words with +'s
    if [info exists env(PATH_INFO)] {
	set args [split [crange $env(PATH_INFO) 1 end] /]
    } else {
	set args {}
    }
    if [info exists env(QUERY_STRING)] {
	set bigarg [split $env(QUERY_STRING) &]
    } else {
	set bigarg {}
    }

    foreach arg [concat $bigarg $args] {
	if [regexp {(.*)=(.*)} $arg foo name value] {
	    set name [subhex $name]
	    if ![info exists argcount($name)] {
		set argcount($name) 1
	    } else {
		incr argcount($name)
	    }
	}
    }

    #split assignments on the '&' 
    foreach arg [concat $bigarg $args] {
	if [regexp {(.*)=(.*)} $arg foo name value] {
	    regsub -all {\+} $value { } newval
	    set name [subhex $name]
	    set val [subhex $newval]
	    if ![info exists ar($name)] {
		if [info exists artype($name)] {
		    if {$artype($name)=="list"} {
			if {$val!=""} {
			    set ar($name) [list $val]
			} else {
			    set ar($name) {}
			}
		    } else {
			set ar($name) $val
		    }
		} else {
		    set ar($name) $val
		}
	    } else {
		# multiple selection
		lappend ar($name) $val
	    }
	}
    }
}


####################################
# ecco questo e' il main
####################################

# questo e' l'header della pagina di risposta
puts "Content-type: text/plain"
puts ""

# prima di tutto chiama la procedura che interpreta la
# variabile di ambiente QUERY_STRING restituita dal server httpd
http_proc_cgi_args

# costruisce il nome file da scrivere con la richiesta, e da inviare per mail 
lvarcat vpa "/home/httpd/account/" "join.tmp"
set filn [ join $vpa "" ]

# lo apre in scrittura
set fou [open $filn w]

#ci scrive i dati prevenuti
set tt "nom"
puts $fou "Nome: $ar($tt)"
set tt "cog"
puts $fou "Cognome: $ar($tt)"
set tt "nat"
puts $fou "Nato(a) a: $ar($tt)"
set tt "dat"
puts $fou "il: $ar($tt)"
set tt "ut"
puts $fou "Nome Utente: $ar($tt)"
set tt "pwd"
puts $fou "password: $ar($tt)"
set tt "em"
puts $fou "E-Mail: $ar($tt)"
set tt "wod"
puts $fou "Web-on-demand: $ar($tt)"
set tt "nav"
puts $fou "Navigazione: $ar($tt)"

# Chiude il file che ho scritto 
close $fou

puts ""
puts " ----------------------------------------------"
puts ""
puts "      Ecco le informazioni da te fornite:"
puts ""
puts " ----------------------------------------------"
puts ""
set fou [open $filn r]
set buf [read $fou]
puts $buf
close $fou
puts " ----------------------------------------------"
puts ""
puts "      E' stato prodotto un messaggio per"
puts "      root@iperaudio.ddns.org che le"
puts "      riporta. Tra breve sarai abilitato"
puts ""
puts " ----------------------------------------------"

# spedisce la domanda di iscrizione
eval exec mail -s Domanda_Iscrizione root < /home/httpd/account/join.tmp

# cancella il file temporaneo
file delete $filn
