tclhttpd

Check-in [d5c61ebd08]
Login
Bounty program for improvements to Tcl and certain Tcl packages.
Tcl 2019 Conference, Houston/TX, US, Nov 4-8
Send your abstracts to [email protected]
or submit via the online form by Sep 9.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Merged with trunk
Timelines: family | ancestors | descendants | both | Supports8.6
Files: files | file ages | folders
SHA1: d5c61ebd08ab2a1593be9b11239814b69476c9a7
User & Date: hypnotoad 2015-03-28 08:17:16
Context
2015-03-28
08:33
Folding in Supports8.6 check-in: 88f6a30094 user: hypnotoad tags: 4_0
08:17
Merged with trunk Closed-Leaf check-in: d5c61ebd08 user: hypnotoad tags: Supports8.6
2014-09-10
12:45
Added support for "-dispatch" option to Url_PrefixInstall. This allows for custom thread dispatchers and per-session threading. Leaf check-in: 16399ebdeb user: clif tags: trunk
2014-08-08
15:25
Integrating fixes from trunk check-in: a24d5f8916 user: hypnotoad tags: Supports8.6
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to lib/cookie.tcl.

109
110
111
112
113
114
115

116
117
118
119
120
121
122
# Arguments:
#	args	Name value pairs, where the names are:
#@a		-name	Cookie name
#@a		-value	Cookie value
#@a		-path	Path restriction
#@a		-domain	domain restriction
#@a		-expires	Time restriction

#@r	a formatted cookie

proc Cookie_Make {args} {
    array set opt $args
    set line "$opt(-name)=$opt(-value) ;"
    foreach extra {path domain} {
	if {[info exist opt(-$extra)]} {






>







109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
# Arguments:
#	args	Name value pairs, where the names are:
#@a		-name	Cookie name
#@a		-value	Cookie value
#@a		-path	Path restriction
#@a		-domain	domain restriction
#@a		-expires	Time restriction
#@a		-secure Append "secure" to cookie attributes
#@r	a formatted cookie

proc Cookie_Make {args} {
    array set opt $args
    set line "$opt(-name)=$opt(-value) ;"
    foreach extra {path domain} {
	if {[info exist opt(-$extra)]} {

Changes to lib/mail.tcl.

16
17
18
19
20
21
22



23
24
25


26
27
28
29
30
31
32
package require httpd	;# Httpd_Webmaster
package require httpd::config	;# Config
package require httpd::direct	;# Direct_Url
package require httpd::utils	;# file protect_text

# No useful default, but we define procedures so the vanilla server
# can start up.




if {[info exists Config(mail)] && ($Config(mail) != {})} {
    set Mail(server) $Config(mail)


}

package require smtp
package require mime

# Mail_Send
#	Send email to recipients using tcllib's smtp client.






>
>
>



>
>







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
package require httpd	;# Httpd_Webmaster
package require httpd::config	;# Config
package require httpd::direct	;# Direct_Url
package require httpd::utils	;# file protect_text

# No useful default, but we define procedures so the vanilla server
# can start up.

# Config(mail) seems to be an old usage 
# MailServer is defined in tclhttpd.rc

if {[info exists Config(mail)] && ($Config(mail) != {})} {
    set Mail(server) $Config(mail)
} elseif {[config::cget MailServer] ne ""} {
    set Mail(server) [config::cget MailServer]
}

package require smtp
package require mime

# Mail_Send
#	Send email to recipients using tcllib's smtp client.

Changes to lib/session.tcl.

1
2
3
4

5
6
7


8

9
10
11
12
13
14
15
...
368
369
370
371
372
373
374
375





376
377

378
379
380
381
382
383
384
# session.tcl -- 
# Session management support.
#
# A session is implemented as a safe slave interpreter that holds its state.

# Creating a session with Session_Create returns a 4 character ID.
# The idea is that form data will have either
# session=new or session=XXXX


# Use Session_Match to find and/or create a session based on query data.

# Use Session_Destroy to delete one session, and Session_Reap to
# clean up "old" sessions.
#
# A session has a type, which is used to automatically create aliases for
# the slave.  If the type is Foo, then every Tcl procedure named Foo_*
# in the master will be created as an alias.  The Foo_ prefix gets
# stripped off the alias name in the slave.
................................................................................
	# there's no stored session
	return "Session: Invalid session id."
    }
}

# Find the correct session, and return the proper interp or error.
# If the session is "new", then create a new one.
# - query: The array containing the form and/or url query





# - type:  The type of this session
# - error_name:  The variable holding the error result (if any)


proc Session_Match {querylist {type {}} {error_name error} {isSafe 1}} {
    upvar $error_name error

    # Check the session informatioin provided in the query data.

    if {[catch {
|



>
|
<
|
>
>

>







 







|
>
>
>
>
>
|

>







1
2
3
4
5
6

7
8
9
10
11
12
13
14
15
16
17
18
...
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
 # session.tcl -- 
# Session management support.
#
# A session is implemented as a safe slave interpreter that holds its state.
#
# Creating a session with Session_Create returns either a 4 character ID

# (if MD5 is missing or Session(short) is true) or an unforgeable MD5
# hash.
#
# Use Session_Match to find and/or create a session based on query data.
#
# Use Session_Destroy to delete one session, and Session_Reap to
# clean up "old" sessions.
#
# A session has a type, which is used to automatically create aliases for
# the slave.  If the type is Foo, then every Tcl procedure named Foo_*
# in the master will be created as an alias.  The Foo_ prefix gets
# stripped off the alias name in the slave.
................................................................................
	# there's no stored session
	return "Session: Invalid session id."
    }
}

# Find the correct session, and return the proper interp or error.
# If the session is "new", then create a new one.
# - query:       The array containing the form and/or url query
#    session:	Either an ID or "new".  
#               an ID will return that ID to confirm that the session is valid
#                 or will return an empty string if session is invalid.
#               "new" will create a new session.
#    sequence:   Sequence position if this is a sequential set of pages.
# - type:        The type of this session
# - error_name:  The variable holding the error result (if any)
# - isSafe:      True to create a safe interp, false for normal.

proc Session_Match {querylist {type {}} {error_name error} {isSafe 1}} {
    upvar $error_name error

    # Check the session informatioin provided in the query data.

    if {[catch {

Changes to lib/url.tcl.

122
123
124
125
126
127
128




129
130
131
132
133
134
135
136
...
370
371
372
373
374
375
376



377
378
379
380
381
382
383
...
426
427
428
429
430
431
432



433
434
435

436
437
438
439
440
441
442
		[list Url_DeferredDispatch $prefix $suffix]
	    return
	}

	# Invoke the URL domain handler either in this main thread
	# or in a worker thread





	if {$Url(thread,$prefix)} {
	    Count UrlToThread
	    Thread_Dispatch $sock \
		    [concat $Url(command,$prefix) [list $sock $suffix]]
	} else {
	    Count UrlEval
	    eval $Url(command,$prefix) [list $sock $suffix]
	}
................................................................................
#		-callback cmd
#			A callback to make when the request completes
#			with or without error, timeout, etc.
#		-readpost boolean
#			To indicate we should pre-read POST data.
#		-filter cmd
#			A command filter to be run on dynamic content




proc Url_PrefixInstall {prefix command args} {
    global Url

    # Add the url to the prefixset, which is a regular expression used
    # to pick off the prefix from the URL

................................................................................
		}
		-readpost {
		    set readpost $v
		}
		-filter {
		    set Url(filter,$prefix) $v
		}



		default {
		    return -code error "Unknown option $n.\
                        Must be -thread, -callback, -filter or -readpost"

		}
	    }
	}
    }
    set Url(readpost,$prefix) $readpost

    # The decision to use worker threads is done on a domain-by-domain basis






>
>
>
>
|







 







>
>
>







 







>
>
>


<
>







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
...
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
...
433
434
435
436
437
438
439
440
441
442
443
444

445
446
447
448
449
450
451
452
		[list Url_DeferredDispatch $prefix $suffix]
	    return
	}

	# Invoke the URL domain handler either in this main thread
	# or in a worker thread

        if {[info exists Url(dispatch,$prefix)]} {
	    Count UrlCustom
	    $Url(dispatch,$prefix) $sock \
		    [concat $Url(command,$prefix) [list $sock $suffix]]
	} elseif {$Url(thread,$prefix)} {
	    Count UrlToThread
	    Thread_Dispatch $sock \
		    [concat $Url(command,$prefix) [list $sock $suffix]]
	} else {
	    Count UrlEval
	    eval $Url(command,$prefix) [list $sock $suffix]
	}
................................................................................
#		-callback cmd
#			A callback to make when the request completes
#			with or without error, timeout, etc.
#		-readpost boolean
#			To indicate we should pre-read POST data.
#		-filter cmd
#			A command filter to be run on dynamic content
#               -dispatch cmd
#                       A custom dispatcher.  The receiving command should
#                       accept arguments similar to Thread_Dispatch.

proc Url_PrefixInstall {prefix command args} {
    global Url

    # Add the url to the prefixset, which is a regular expression used
    # to pick off the prefix from the URL

................................................................................
		}
		-readpost {
		    set readpost $v
		}
		-filter {
		    set Url(filter,$prefix) $v
		}
		-dispatch {
		    set Url(dispatch,$prefix) $v
		}
		default {
		    return -code error "Unknown option $n.\

                        Must be -callback, -dispatch, -filter, -readpost or -thread"
		}
	    }
	}
    }
    set Url(readpost,$prefix) $readpost

    # The decision to use worker threads is done on a domain-by-domain basis