Index: openacs-4/packages/acs-tcl/acs-tcl.info
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/acs-tcl.info,v
diff -u -r1.95 -r1.95.2.1
--- openacs-4/packages/acs-tcl/acs-tcl.info	11 Feb 2019 11:58:59 -0000	1.95
+++ openacs-4/packages/acs-tcl/acs-tcl.info	15 Feb 2019 11:03:57 -0000	1.95.2.1
@@ -9,7 +9,7 @@
     <implements-subsite-p>f</implements-subsite-p>
     <inherit-templates-p>t</inherit-templates-p>
     
-    <version name="5.10.0d23" url="http://openacs.org/repository/download/apm/acs-tcl-5.10.0d23.apm">
+    <version name="5.10.0d24" url="http://openacs.org/repository/download/apm/acs-tcl-5.10.0d24.apm">
         <owner url="http://openacs.org">OpenACS</owner>
         <summary>The Kernel Tcl API library.</summary>
         <release-date>2017-08-06</release-date>
@@ -18,7 +18,7 @@
         <license>GPL version 2</license>
         <maturity>3</maturity>
 
-        <provides url="acs-tcl" version="5.10.0d23"/>
+        <provides url="acs-tcl" version="5.10.0d24"/>
         <requires url="acs-bootstrap-installer" version="5.10.0d4"/>
         <requires url="acs-kernel" version="5.10.0d0"/>
 
Index: openacs-4/packages/acs-tcl/tcl/security-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/security-procs.tcl,v
diff -u -r1.126 -r1.126.2.1
--- openacs-4/packages/acs-tcl/tcl/security-procs.tcl	11 Feb 2019 11:52:48 -0000	1.126
+++ openacs-4/packages/acs-tcl/tcl/security-procs.tcl	15 Feb 2019 11:03:57 -0000	1.126.2.1
@@ -1148,6 +1148,7 @@
     {-secret ""}
     {-token_id ""}
     {-max_age ""}
+    {-user_binding 0}
     value
 } {
     Returns a digital signature of the value. Negative token_ids are
@@ -1163,6 +1164,11 @@
 
     @param token_id allows the caller to specify a token_id which is then ignored so don't use it.
 
+    @param user_binding allows to bind a signature to a user.
+           When the value is "-1" only the user who created the signature can
+           obtain the value again. A value of 0 (default) means no user binding.
+           The permissible values might be extended in the future.
+    
     @param value the value to be signed.
 } {
     if {$token_id eq ""} {
@@ -1185,7 +1191,18 @@
         set expire_time [expr {$max_age + [ns_time]}]
     }
 
-    set hash [ns_sha1 "$value$token_id$expire_time$secret_token"]
+    switch $user_binding {
+        -1 {
+            set user_id [ad_conn user_id]
+            append token_id :$user_binding
+        }
+        0 {
+            set user_id ""
+        }
+        default {error "invalid user_binding"}
+    }
+
+    set hash [ns_sha1 "$value$token_id$expire_time$secret_token$user_id"]
     set signature [list $token_id $expire_time $hash]
 
     return $signature
@@ -1239,15 +1256,17 @@
 
 } {
 
+    lassign [split $token_id :] raw_token_id user_binding
+
     if { $secret eq "" } {
-        if { $token_id eq "" } {
+        if { $raw_token_id eq "" } {
             ns_log Debug "__ad_verify_signature: Neither secret, nor token_id supplied"
             return 0
-        } elseif {![string is integer -strict $token_id]} {
-            ns_log Warning "__ad_verify_signature: token_id <$token_id> is not an integer"
+        } elseif {![string is integer -strict $raw_token_id]} {
+            ns_log Warning "__ad_verify_signature: token_id <$raw_token_id> is not an integer"
             return 0
         }
-        set secret_token [sec_get_token $token_id]
+        set secret_token [sec_get_token $raw_token_id]
 
     } else {
         set secret_token $secret
@@ -1256,9 +1275,17 @@
     ns_log Debug "__ad_verify_signature: Getting token_id $token_id, value $secret_token ; "
     ns_log Debug "__ad_verify_signature: Expire_Time is $expire_time (compare to [ns_time]), hash is $hash"
 
-    # validate cookie: verify hash and expire_time
-    set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token"]
+    if {$user_binding == -1} {
+        set user_id [ad_conn user_id]
+    } else {
+        set user_id ""
+    }
 
+    #
+    # Compute hash based on tokes, expire_time and user_id.
+    #
+    set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token$user_id"]
+
     # Need to verify both hash and expiration
     set hash_ok_p 0
     set expiration_ok_p 0
@@ -1267,11 +1294,13 @@
         ns_log Debug "__ad_verify_signature: Hash matches - Hash check OK"
         set hash_ok_p 1
     } else {
-        # check to see if IE is lame (and buggy!) and is expanding \n to \r\n
+        #
+        # Check to see if IE is lame (and buggy!) and is expanding \n to \r\n
         # See: http://rhea.redhat.com/bboard-archive/webdb/000bfF.html
+        #
         set value [string map [list \r ""] $value]
         set org_computed_hash $computed_hash
-        set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token"]
+        set computed_hash [ns_sha1 "$value$token_id$expire_time$secret_token$user_id"]
 
         if {$computed_hash eq $hash} {
             ns_log Debug "__ad_verify_signature: Hash matches after correcting for IE bug - Hash check OK"
Index: openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl
===================================================================
RCS file: /usr/local/cvsroot/openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl,v
diff -u -r1.189 -r1.189.2.1
--- openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl	31 Jan 2019 17:07:58 -0000	1.189
+++ openacs-4/packages/acs-tcl/tcl/utilities-procs.tcl	15 Feb 2019 11:03:57 -0000	1.189.2.1
@@ -948,7 +948,7 @@
             # path up to this point is already correctly encoded.
             set export_string $base[expr {$export_string ne "" ? "&$export_string" : ""}]
         } else {
-            # The base has no query vars: encode url part if not
+            # The base has no query vars: encode URL part if not
             # explicitly said otherwise. Include also as exception
             # trivial case of the base being the dummy url '#'.
             if {!$no_base_encode_p && $base ne "#"} {
@@ -973,16 +973,20 @@
     Call ad_sign parameterized via max_age and secret specified in urlencoding
 } {
     set max_age ""
+    set user_binding 0
     set secret  [ns_config "ns/server/[ns_info server]/acs" parametersecret ""]
     foreach def [split $params &] {
         lassign [split $def =] key val
         switch -- $key {
             max_age -
             secret {set $key [ad_urldecode_query $val]}
+            user {
+                set user_binding -1
+            }
         }
     }
 
-    return [ad_sign -max_age $max_age -secret $secret $value]
+    return [ad_sign -max_age $max_age -secret $secret -user_binding $user_binding $value]
 }