Wapp

wapp-set-cookie patch to allow specifying an expiry time + secure flag
Login

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]]} {