You are viewing a plain text version of this content. The canonical link for it is here.
Posted to websh-cvs@tcl.apache.org by ro...@apache.org on 2004/09/15 11:26:54 UTC

cvs commit: tcl-websh/src/tests cookiecontext.test

ronnie      2004/09/15 02:26:54

  Modified:    doc      quickref.xml
               src/generic cookie.ws3
               src/tests cookiecontext.test
  Log:
  - fixed cookie expiry handling (locale independent) and adapted tests and documentation
  
  Revision  Changes    Path
  1.58      +12 -7     tcl-websh/doc/quickref.xml
  
  Index: quickref.xml
  ===================================================================
  RCS file: /home/cvs/tcl-websh/doc/quickref.xml,v
  retrieving revision 1.57
  retrieving revision 1.58
  diff -u -r1.57 -r1.58
  --- quickref.xml	31 Oct 2003 17:06:43 -0000	1.57
  +++ quickref.xml	15 Sep 2004 09:26:53 -0000	1.58
  @@ -1257,7 +1257,7 @@
   	    % web::put "Hello, world\n"
   	    Content-Type: text/html
   	    Set-Cookie: my cookie that contains data
  -	    Generator: websh3.00 (c) Netcetera AG, http://netcetera.ch
  +	    Generator: websh3.5.1
   
   	    Hello, world
   	    %
  @@ -1993,11 +1993,16 @@
   	    <listitem>
   	      <para>
   		set the expiration date of the cookie. Possible values
  -		for <option>time</option> are <emphasis>day</emphasis>
  -		(lifetime: one day), <emphasis>week</emphasis>,
  -		<emphasis>today</emphasis>,
  +		for <option>time</option> are
   		<emphasis>seconds</emphasis> (time in seconds since
  -		1-1-1970) or <emphasis>date-string</emphasis>.
  +		1970-01-01) or <emphasis>date-string</emphasis> (any
  +                time string that Tcl can scan. Note that therefore many 
  +                relative times, such as <emphasis>day</emphasis>, 
  +		<emphasis>week</emphasis>, <emphasis>2 weeks</emphasis>,
  +		<emphasis>tomorrow</emphasis>, etc.
  +		are possible. Default is <emphasis>day</emphasis> (i.e. cookie
  +		expires in 24 hours. Use <emphasis>-expires ""</emphasis> to 
  +		send a cookie without an expires parameter.
   	      </para>
   	    </listitem>
   	  </varlistentry>
  
  
  
  1.4       +18 -19    tcl-websh/src/generic/cookie.ws3
  
  Index: cookie.ws3
  ===================================================================
  RCS file: /home/cvs/tcl-websh/src/generic/cookie.ws3,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- cookie.ws3	3 Feb 2004 09:59:38 -0000	1.3
  +++ cookie.ws3	15 Sep 2004 09:26:53 -0000	1.4
  @@ -143,29 +143,28 @@
   	    } else {
   
   		# write the expiry-date
  -		set expsec [clock seconds]
   		if {[regexp {^[0-9]+$} $_expires]} {
  -		    ## is a number
  +		    # expiry given as epoch seconds
   		    set expsec $_expires
  -		} else {
  -		    if {[string equal $_expires "day"]} {
  -			incr expsec 86400
  -		    } elseif { [string equal $_expires "week"] } {
  -			incr expsec 604800
  -		    }
  +		} elseif {[string length $_expires] && ![catch {clock scan $_expires} msg] } {
  +		    # expiry given in tcl scannable date-time string
  +		    # incl. "day", "tomorrow", "week" ...
  +		    set expsec $msg
   		}
  -		if { [catch {clock scan $_expires} msg] } {
  -		    
  -		    set expstr $_expires
  -		} else {
  -		    
  -		    if {[string equal $_expires "today"]} {
  -			set expstr $_expires
  +
  +		if {[info exists expsec]} {
  +		    # we have an (optional) expiry
  +		    global env
  +		    if {[info exists env(LC_TIME)]} {
  +			set LC_TIME $env(LC_TIME)
  +		    }
  +		    set env(LC_TIME) C
  +		    set expstr [clock format $expsec -format "%a, %d-%b-%Y %H:%M:%S %Z" -gmt true]
  +		    if {[info exists LC_TIME]} {
  +			set env(LC_TIME) $LC_TIME
   		    } else {
  -			set expstr [clock format $expsec -format "%a, %d-%b-%Y %H:%M:%S %Z" -gmt true]
  +			unset env(LC_TIME)
   		    }
  -		}
  -		if { [string length $expstr] } {
   		    append cookie "; expires=$expstr"
   		}
   	    }
  
  
  
  1.4       +107 -7    tcl-websh/src/tests/cookiecontext.test
  
  Index: cookiecontext.test
  ===================================================================
  RCS file: /home/cvs/tcl-websh/src/tests/cookiecontext.test,v
  retrieving revision 1.3
  retrieving revision 1.4
  diff -u -r1.3 -r1.4
  --- cookiecontext.test	1 Mar 2004 10:07:36 -0000	1.3
  +++ cookiecontext.test	15 Sep 2004 09:26:53 -0000	1.4
  @@ -34,14 +34,114 @@
       cctx::cset somekey somevalue
       cctx::commit
       web::put "Websh"
  +    namespace delete cctx
   
       set text
  -} "Content-Type: text/html\u0D
  -Set-Cookie: myTestCookie=XDZ0YDSy89ppeUCWTjjya38uY4Kn88; expires=today; path=/some/app\u0D
  +
  +    set now [clock seconds]
  +
  +    # expected cookie pattern
  +    set pattern "Content-Type: text/html\u0D
  +Set-Cookie: myTestCookie=XDZ0YDSy89ppeUCWTjjya38uY4Kn88; expires=(.*); path=/some/app\u0D
   Generator: cookiecontext-1.1\u0D
   \u0D
   Websh"
   
  +    if {[regexp $pattern $text dummy timestring]} {
  +	set time [clock scan $timestring]
  +	set result [expr {($now - $time) < 2}]
  +    } else {
  +	set result 0
  +    }
  +
  +} 1
  +
  +test cookiecontext-1.1a {create a cookie-context expiry tomorrow} {
  +
  +    if {[info exists text1a]} {unset text1a}
  +
  +    web::response -select #text1a
  +    web::response -set Generator "cookiecontext-1.1a"
  +    web::cookiecontext cctx -path "/some/app" -expires "day" -channel #text1a
  +    cctx::new myTestCookie
  +    cctx::cset somekey somevalue
  +    cctx::commit
  +    web::put "Websh"
  +    namespace delete cctx
  +
  +    set text1a
  +
  +    set now [clock seconds]
  +
  +    # expected cookie pattern
  +    set pattern "Content-Type: text/html\u0D
  +Set-Cookie: myTestCookie=XDZ0YDSy89ppeUCWTjjya38uY4Kn88; expires=(.*); path=/some/app\u0D
  +Generator: cookiecontext-1.1a\u0D
  +\u0D
  +Websh"
  +
  +    if {[regexp $pattern $text1a dummy timestring]} {
  +	set time [clock scan $timestring]
  +	set result [expr {($now + 86400 - $time) < 2}]
  +    } else {
  +	set result 0
  +    }
  +
  +} 1
  +
  +test cookiecontext-1.1a1 {create a cookie-context expiry default} {
  +
  +    if {[info exists text1a1]} {unset text1a1}
  +
  +    web::response -select #text1a1
  +    web::response -set Generator "cookiecontext-1.1a1"
  +    web::cookiecontext cctx -path "/some/app" -channel #text1a1
  +    cctx::new myTestCookie
  +    cctx::cset somekey somevalue
  +    cctx::commit
  +    web::put "Websh"
  +    namespace delete cctx
  +
  +    set text1a1
  +
  +    set now [clock seconds]
  +
  +    # expected cookie pattern
  +    set pattern "Content-Type: text/html\u0D
  +Set-Cookie: myTestCookie=XDZ0YDSy89ppeUCWTjjya38uY4Kn88; expires=(.*); path=/some/app\u0D
  +Generator: cookiecontext-1.1a1\u0D
  +\u0D
  +Websh"
  +
  +    if {[regexp $pattern $text1a1 dummy timestring]} {
  +	set time [clock scan $timestring]
  +	set result [expr {($now + 86400 - $time) < 2}]
  +    } else {
  +	set result 0
  +    }
  +
  +} 1
  +
  +test cookiecontext-1.1b {create a cookie-context no expiry} {
  +
  +    if {[info exists text1b]} {unset text1b}
  +
  +    web::response -select #text1b
  +    web::response -set Generator "cookiecontext-1.1b"
  +    web::cookiecontext cctx -path "/some/app" -expires "" -channel #text1b
  +    cctx::new myTestCookie
  +    cctx::cset somekey somevalue
  +    cctx::commit
  +    web::put "Websh"
  +    namespace delete cctx
  +
  +    set text1b
  +} "Content-Type: text/html\u0D
  +Set-Cookie: myTestCookie=XDZ0YDSy89ppeUCWTjjya38uY4Kn88; path=/some/app\u0D
  +Generator: cookiecontext-1.1b\u0D
  +\u0D
  +Websh"
  +
   # -----------------------------------------------------------------------------
   # test to remove (i.e. forget) a state
   # ----------------------------------------------------------------------------
  @@ -75,7 +175,7 @@
       web::response -select #cctx1_3
       web::response -set Generator "cookiecontext-1.3"
       web::cookiecontext cctx -path "/some/app13" \
  -	-expires "Wed, 15-03-2000 00:00:00 MET" -channel #cctx1_3 \
  +	-expires "Wed, 15-Mar-2000 00:00:00 MET" -channel #cctx1_3 \
   	-secure 1 -domain "www.websh.com"
       cctx::new myThirdCookie
       cctx::cset somekey somevalue
  @@ -84,14 +184,14 @@
   
       set cctx1_3 
   } "Content-Type: text/html\u0D
  -Set-Cookie: myThirdCookie=XDZ0YDSy89ppeUCWTjjya38uY4Kn88; expires=Wed, 15-03-2000 00:00:00 MET; path=/some/app13; domain=www.websh.com; secure\u0D
  +Set-Cookie: myThirdCookie=XDZ0YDSy89ppeUCWTjjya38uY4Kn88; expires=Tue, 14-Mar-2000 23:00:00 GMT; path=/some/app13; domain=www.websh.com; secure\u0D
   Generator: cookiecontext-1.3\u0D
   \u0D
   Websh"
   
   test cookiecontext-1.4 {create an uncrypted cookie-context} {
       web::response -select \#cctx1_4
  -    web::cookiecontext c -crypt 0 -expires "Wed, 15-03-2000 00:00:00 MET"
  +    web::cookiecontext c -crypt 0 -expires "Wed, 15-Mar-2000 00:00:00 MET"
       web::response -set Generator "cookiecontext-1.4"
       c::init cname
       c::cset foo bar
  @@ -101,7 +201,7 @@
       web::put "show me the cookie"
       set cctx1_4
   } "Content-Type: text/html\u0D
  -Set-Cookie: cname=cset+1%3d2+false%0acset+foo+bar%0acset+im+tired; expires=Wed, 15-03-2000 00:00:00 MET\u0D
  +Set-Cookie: cname=cset+1%3d2+false%0acset+foo+bar%0acset+im+tired; expires=Tue, 14-Mar-2000 23:00:00 GMT\u0D
   Generator: cookiecontext-1.4\u0D
   \u0D
   show me the cookie"
  
  
  

---------------------------------------------------------------------
To unsubscribe, e-mail: websh-cvs-unsubscribe@tcl.apache.org
For additional commands, e-mail: websh-cvs-help@tcl.apache.org