Dear websh users,
I need a cookie. I know there are very nice sessions. But I really need
a cookie. I have a cross-technology web application. It works on cgi
(with cgi.tcl), on tclhttpd, on rivet, and I am porting it to websh. As
it is such an application, I have my own session environment. And I need
to create it again. And I do not catch how cookies are implemented in websh.
My code is attached for managing the cookies and for the final output.
Please, could you give me some hints ?
Best regards,
Arnaud LAPREVOTE
--
Arnaud LAPREVOTE - Directeur R&D Mandriva/Linbox FAS
152, rue de Grigy Technopôle Metz 2000 57070 METZ
43, rue d'Aboukir 75002 PARIS
tel : 03 87 50 87 90 - 06 11 36 15 30 fax : 03 87 75 19 26
E-mail : [EMAIL PROTECTED] Web: http://mandriva.com
#
# Universal way to get a cookie
#
proc fas_get_cookie { cookie_name } {
global conf
fas_debug "fas_basic_proc::fas_get_cookie - $cookie_name"
#fas_debug "conf(tclhttpd) => [info exists conf(tclhttpd)]"
#fas_debug "conf(tclrivet) => [info exists conf(tclrivet)]"
if { [info exists conf(tclhttpd)] } {
# I am in the tclhttpd case
#global env
set result ""
# Directly stolen in doc.tcl of tclhttpd
#if {[info exist env(HTTP_COOKIE)]} {
# set rawcookie $env(HTTP_COOKIE)
#} elseif {![info exist env(HTTP_COOKIE)]} {
# # Try to find the connection
# if {[info exists env(HTTP_CHANNEL)]} {
# upvar #0 Httpd$env(HTTP_CHANNEL) data
# if {[info exist data(mime,cookie)]} {
# set rawcookie $data(mime,cookie)
# }
# }
#}
#if {[info exist rawcookie]} {
# foreach pair [split $rawcookie \;] {
# lassign [split [string trim $pair] =] key value
# if {[string compare $cookie $key] == 0} {
# lappend result $value
# }
# }
#}
package require httpd::cookie
set result [Cookie_Get $cookie_name]
fas_debug "fas_get_cookie - tclhttpd - $cookie_name ->$result<-"
if { $result == "" } {
fas_debug "fas_basic_proc::fas_get_cookie - tclhttpd no cookie $cookie_name found"
error 1
} else {
fas_debug "fas_basic_proc::fas_get_cookie - tclhttpd $cookie_name => $result"
return $result
}
} elseif { [info exists conf(tclrivet) ] } {
set value [cookie get $cookie_name]
if { $value == "" } {
fas_debug "fas_basic_proc::fas_get_cookie - rivet no cookie $cookie_name found"
error "no cookie found"
}
fas_debug "fas_basic_proc::fas_get_cookie - rivet cookie $cookie_name => $value"
return $value
} elseif { [info exists conf(websh) ] } {
# TO BE DONE - not yet finished - websh cookies to be treated
set value ""
if { $value == "" } {
fas_debug "fas_basic_proc::fas_get_cookie - websh no cookie $cookie_name found"
error "no cookie found"
}
fas_debug "fas_basic_proc::fas_get_cookie - websh cookie $cookie_name => $value"
return $value
} else {
# It is the cgi case
#cgi_import_cookie $cookie_name
set value [cgi_cookie_get -all $cookie_name]
#return [set $cookie_name]
fas_debug "fas_basic_proc::fas_get_cookie - cgi $cookie_name => $value"
return $value
}
}
#
# Universal way to set a cookie
#
proc fas_set_cookie { cookie_name cookie_value } {
global conf
#global FAS_VIEW_URL
fas_debug "fas_basic_proc::fas_set_cookie - $cookie_name <= $cookie_value"
if { [info exists conf(tclhttpd)] } {
package require httpd::cookie
Cookie_Set -name $cookie_name -value $cookie_value -path $::FAS_VIEW_URL
#set line "${cookie_name}=${cookie_value} ;path=${FAS_VIEW_URL} ;"
#set sock $conf(sock)
#Httpd_SetCookie $sock $line
#Cookie_Set name $cookie_name value $cookie_value
} elseif { [info exists conf(tclrivet)] } {
global FAS_HOSTNAME
fas_debug "fas_basic_proc::fas_set_cookie rivet cookie set $cookie_name $cookie_value -path $::FAS_VIEW_URL -host $FAS_HOSTNAME"
cookie set $cookie_name $cookie_value -path $::FAS_VIEW_URL -host $FAS_HOSTNAME
#if { $conf(mod_rewrite) } {
# global FAS_VIEW_REWRITE_URL
# cookie set $cookie_name $cookie_value -path $FAS_VIEW_REWRITE_URL -host $FAS_HOSTNAME
#}
} elseif { [info exists conf(websh)] } {
global FAS_HOSTNAME
fas_debug "WEBSH - fas_set_cookie not yet implemented - TO BE DONE"
#cookie set $cookie_name $cookie_value -path $::FAS_VIEW_URL -host $FAS_HOSTNAME
} else {
set $cookie_name $cookie_value
cgi_export_cookie $cookie_name path=$::FAS_VIEW_URL
}
}
# Writing of output
proc content_display { filetype content } {
global conf
#fas_debug "not_binary::content_display $filetype content"
# Now all is done in fashtml with links
#global MAIN_LOG MAIN_LOG_SHOW
#if { $MAIN_LOG && $MAIN_LOG_SHOW } {
# global MAIN_LOG_STRING
# set main_log "<BR><H2>MAIN_LOG</H2><PRE>${MAIN_LOG_STRING}</PRE>"
# set content [insert_before_body $content $main_log]
#}
#global DEBUG DEBUG_SHOW _cgi_uservar
#if { $DEBUG && $DEBUG_SHOW } {
# set debug_content "<BR><H2>DEBUG</H2><H3>CGI VARIABLES</H3>"
# global DEBUG_STRING
# foreach element [array names _cgi_uservar] {
# append debug_content "<b>$element</b> -> $_cgi_uservar($element)<BR>\n"
# }
# append debug_content "<H3>DEBUG TRACE</H3>"
# append debug_content "<PRE>\n${DEBUG_STRING}\n</PRE>"
# set content [insert_before_body $content $debug_content]
#}
if { ![info exists conf(tclhttpd)] && ![info exists conf(tclrivet)] && ![info exists conf(websh)] } {
cgi_http_head {
cgi_content_type [${filetype}::mimetype]
fas_session::export_session
}
#_cgi_http_head_implicit
# I added the cgi_body for the debug getting cookies and variables
puts "$content"
} elseif { [info exists conf(tclrivet)] } {
if { [catch {headers type [${filetype}::mimetype]} ] } {
puts "$content"
} else {
fas_session::export_session
puts "$content"
}
} elseif { [info exists conf(websh)] } {
if { [catch {web::response -set Content-Type [${filetype}::mimetype]} ] } {
web::put "$content"
} else {
fas_session::export_session
web::put "$content"
}
} else {
#fas_debug "not_binary::content_display tclhttpd case"
# I am in the tclhttpd case, I do something
set sock $conf(sock)
# ????????????? to be checked
fas_session::export_session
package require httpd::cookie
Cookie_Save $sock
Httpd_ReturnData $sock [${filetype}::mimetype] "$content"
}
}
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
