wm geom .konsola 631x808+912+263; wm geom .output 636x192+907+38; kons_font 13; # Morasko
## tclhttpd - SIK, temat D, zadanie z clips-em, 04.2018
# + czy handler domeny moze opoznic wywolanie Httpd_ReturnData ? TAK!!!
# + przewaga tclhttpd nad "reczna" impl. http: to nie takie proste...
#
lappend auto_path /root/tcl/tcllib /root/tcl/tls1.7
source /root/tcl/111/file_vfs_84.tcl
package re vfs::zip
vfs::zip::Mount /root/tcl/222/kitten.zip ./kitten
set argv_old $argv
set argv "-port 9000 -https_port 9001"
source ./kitten/tclhttpd3.5.1/bin/httpd_app.tcl
rename bgerror {}
set argv $argv_old
exec seamonkey http://localhost:9000 &
# !!! do tego miejsca wykonac !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Url_PrefixInstall /eee eee_obsluga
#Url_PrefixRemove /eee
# analogiczne do Cookie_GetSock ?!
proc Query_GetSock sock {
upvar #0 Httpd$sock data
if {[info exists data(query)]} {
return [Url_DecodeQuery $data(query)]
} {
return ""
}
}
proc eee_obsluga {sock sufix} {
upvar #0 Httpd$sock data
append html "[clock format [clock seconds]], sufix: $sufix <br>\n"
append html "line: $data(line) <br>\n"
#append html "---<br>[array get data]<br>---<br>"
#append html "---<br>[array get data mime,*]<br>---<br>"
set d1 [Query_GetSock $sock]
# zwraca dict ze wsz. parametrami (z url-a i z danych POST)
append html "query: $d1, <br>\n"
set d2 [Cookie_GetSock $sock qqq]
if {$d2==""} {
Httpd_SetCookie $sock [Cookie_Make -name qqq -value 123123]
# tak to nalezy robic, a nie przez Cookie_Set/Save !!
}
append html "cookie: qqq = $d2, <br>"
#Httpd_ReturnData $sock "text/html" $html
Httpd_ReturnData $sock "text/html; charset=utf-8" $html
# + to naprawia probelm encoding !!
#after 5000 [list Httpd_ReturnData $sock "text/html; charset=utf-8" $html]
# + opoznione wysylanie odpowiedzi...
# + TAK!!! mozna to robic...
# + mozna pozostawic wywolanie tej cmd handlerowi cat_obsluga
}
file chan sock*
#% sock6 sock7 sock11
#% sock6 sock7 sock10 sock11 sock12
# + sock6 i sock7 to pasywne sockety http i https...
info vars Httpdsock*
#% Httpdsock11
#% Httpdsock10 Httpdsock11 Httpdsock12
# ...
info comm Httpd_*Head*
#% Httpd_RemoveHeaders Httpd_DumpHeaders Httpd_AddHeaders
info comm Httpd_*Data*
#% Httpd_ReturnData Httpd_ReadPostDataAsync Httpd_GetPostDataAsync Httpd_ReturnCacheableData Httpd_CopyPostData Httpd_GetPostData Httpd_PostDataSize
info comm Httpd_*Get*
#% Httpd_GetPostChannel Httpd_GetPostDataAsync Httpd_GetPostData
info comm Httpd_*Coo*
#% Httpd_SetCookie Httpd_RemoveCookies
# sposob na uruchamianie zewn. procesu i komunikacje z nim...
#
set cat [open |cat r+]
fconfigure $cat -blocking 0
puts $cat "123 123 123"; flush $cat
gets $cat
close $cat
fileevent $cat readable "cat_obsluga $sessid"
proc cat_obsluga {sessid} {
set sock [lindex $::sesja($sessid) 0]
set cat [lindex $::sesja($sessid) 1]
# $::sesja($sessid) zawiera 2 kanaly:
# sock do http, cat do zewn. procesu
set html ...
Httpd_ReturnData $sock "text/html; charset=utf-8" $html
}
# obsluga sesji...
#
set id1 [Session_Create qqq]
#% e5537279b8544003e5fc2ff5fd0e6848
join [interp slaves] \n
#% interpe5537279b8544003e5fc2ff5fd0e6848
Session_Match "session $id1"
#% e5537279b8544003e5fc2ff5fd0e6848
Session_Variable $id1 zm 111
#% 111
Session_Variable $id1 zm
#% 111
interp$id1 eval session
#% e5537279b8544003e5fc2ff5fd0e6848
interp$id1 eval info vars
Session_Destroy $id1
# zm. globalne tclhttpd...
# + dla kazdego zadania http jest tworzona tabl Httpd$sock...
# + jest obsluga keep-alive, ale po jakims czasie jest timeout...
#
info vars Httpd*
#% Httpdsock10 Httpd Httpd_Errors Httpd_EnvMap HttpdRedirectFormat HttpdAuthorizationFormat Httpd_ErrorFormat
#% Httpd Httpd_Errors Httpd_EnvMap HttpdRedirectFormat HttpdAuthorizationFormat Httpd_ErrorFormat
array get Httpd
array get Httpdsock10
#% ipaddr 127.0.0.1 state start cancel after#16 self {http localhost 9000} version 0 left 24
fconfigure sock6
#% -blocking 1 -buffering full -buffersize 4096 -encoding iso8859-2 -eofchar {} -translation auto -sockname {0.0.0.0 0.0.0.0 9000}
fconfigure sock7
#% -blocking 1 -buffering full -buffersize 4096 -encoding iso8859-2 -eofchar {} -translation auto -sockname {0.0.0.0 0.0.0.0 9001}
exit