wapp-set-cookie patch to allow specifying an expiry time + secure flag
(1.5) By ufko.org on 2025-02-13 09:36:02 edited from 1.4 [source]
Update 2: Oops, now it should be the correct diff with wapp-clear-cookie as well :)
Update: I’m sending a patch that will allow setting not only expiring but also secure cookies.
I moved wappInt-enc-url to the beginning of the block to avoid repeating it too much, although it's unnecessary for an empty value.
While testing ... don't forget that a secure cookie can only be set if the communication is over HTTPS. I hope this will be useful to someone too:
Set examples:
wapp-set-cookie session val
wapp-set-cookie session-secure val 0 secure
wapp-set-cookie timed val 3600
wapp-set-cookie timed-secure val 3600 secure
Clear example:
wapp-clear-cookie session
wapp-clear-cookie session-secure "" -1 secure
wapp-clear-cookie timed "" -1
wapp-clear-cookie timed-secure "" -1 secure
Patch:
--- wapp.tcl.orig Fri Feb 7 06:50:45 2025
+++ wapp.tcl Thu Feb 13 10:07:02 2025
@@ -214,15 +214,15 @@
# Set a cookie
#
-proc wapp-set-cookie {name value} {
+proc wapp-set-cookie {name value {expiry 0} {secure ""}} {
global wapp
- dict lappend wapp .new-cookies $name $value
+ dict lappend wapp .new-cookies $name $value $expiry $secure
}
# Unset a cookie
#
-proc wapp-clear-cookie {name} {
- wapp-set-cookie $name {}
+proc wapp-clear-cookie {name {value {}} {expiry -1} {secure ""}} {
+ wapp-set-cookie $name $value $expiry $secure
}
# Add extra entries to the reply header
@@ -771,18 +771,30 @@
}
set mimetype [dict get $wapp .mimetype]
puts $chan "Content-Type: $mimetype\r"
- if {[dict exists $wapp .new-cookies]} {
- foreach {nm val} [dict get $wapp .new-cookies] {
- if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
- if {$val==""} {
- puts $chan "Set-Cookie: $nm=; HttpOnly; Path=/; Max-Age=1\r"
- } else {
- set val [wappInt-enc-url $val]
- puts $chan "Set-Cookie: $nm=$val; HttpOnly; Path=/\r"
- }
- }
- }
- }
+
+ if {[dict exists $wapp .new-cookies]} {
+ foreach {nm val exp sec} [dict get $wapp .new-cookies] {
+ if {[regexp {^[a-z][-a-z0-9_]*$} $nm]} {
+ set val [wappInt-enc-url $val]
+ if {$val == ""} {
+ if {$sec == "secure"} {
+ puts $chan "Set-Cookie: $nm=; HttpOnly; Secure; Path=/; Max-Age=-1\r"
+ } else {
+ puts $chan "Set-Cookie: $nm=; HttpOnly; Path=/; Max-Age=-1\r"
+ }
+ } elseif {$sec == "secure" && $exp > 0} {
+ puts $chan "Set-Cookie: $nm=$val; HttpOnly; Secure; Path=/; Max-Age=$exp\r"
+ } elseif {$sec == "secure"} {
+ puts $chan "Set-Cookie: $nm=$val; HttpOnly; Secure; Path=/\r"
+ } elseif {$exp > 0} {
+ puts $chan "Set-Cookie: $nm=$val; HttpOnly; Path=/; Max-Age=$exp\r"
+ } else {
+ puts $chan "Set-Cookie: $nm=$val; HttpOnly; Path=/\r"
+ }
+ }
+ }
+ }
+
if {[string match text/* $mimetype]} {
set reply [encoding convertto utf-8 [dict get $wapp .reply]]
if {[regexp {\ygzip\y} [wapp-param HTTP_ACCEPT_ENCODING]]} {