Posted to tcl by marc.ziegenhagen at Tue Nov 23 08:55:55 GMT 2010view raw

  1. # handle organisations-Einheit Domain
  2.  
  3. Debug on redir 5
  4.  
  5. package provide redirDomain 1.0
  6.  
  7. namespace eval redirDomain {
  8.  
  9. proc / { req } {
  10.  
  11. if {![dict exists $req -tls]} {
  12. set redir {}
  13. append redir "https:"
  14. if {[dict exists $req -host] && \
  15. [string length [dict get $req -host]]} {
  16. append redir "//[dict get $req -host]"
  17. } else {
  18. append redir "//localhost"
  19. }
  20. if {[::Site var Https -port] != "443"} {
  21. append redir ":[::Site var Https -port]"
  22. }
  23. append redir /rd/
  24. puts "#################\n\nRedir=$redir"
  25. return [Http Redir $req $redir]
  26. }
  27.  
  28. set C {}
  29. append C [<h1> "Test Redir"]
  30.  
  31. set req [jQ multifile $req] ;# make upload form a multifile
  32. dict set req -content $C
  33. dict set req content-type x-text/html-fragment
  34. dict set req -title "Test Redir"
  35. return $req
  36. }
  37.  
  38. namespace export -clear *
  39. namespace ensemble create -subcommands {}
  40. }