*** ./cgi.tcl.in.orig 2006-05-01 11:15:52.000000000 -0700
--- ./cgi.tcl.in 2006-11-14 16:01:51.000000000 -0800
***************
*** 52,58 ****
if {[info exists _cgi(http_status_done)]} return
set _cgi(http_status_done) 1
! puts "Status: $num $str"
}
# If these are called manually, they automatically generate the extra newline
--- 52,58 ----
if {[info exists _cgi(http_status_done)]} return
set _cgi(http_status_done) 1
! cgi_puts "Status: $num $str"
}
# If these are called manually, they automatically generate the extra newline
***************
*** 1342,1348 ****
set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]]
# explicitly flush all writes to fout, because sometimes the writer
# can hang and we won't get to the termination code
! set dbg_fout [open $dbg_filename w]
set _cgi(input) $dbg_filename
catch {fconfigure $dbg_fout -translation binary}
}
--- 1342,1348 ----
set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]]
# explicitly flush all writes to fout, because sometimes the writer
# can hang and we won't get to the termination code
! set dbg_fout [open $dbg_filename w $_cgi(tmpperms)]
set _cgi(input) $dbg_filename
catch {fconfigure $dbg_fout -translation binary}
}
***************
*** 1409,1415 ****
# read the part into a file
set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]]
! set fout [open $foutname w]
# "catch" permits this to work with Tcl 7.4
catch {fconfigure $fout -translation binary}
_cgi_set_uservar $varname [list $foutname $filename $conttype]
--- 1409,1415 ----
# read the part into a file
set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]]
! set fout [open $foutname w $_cgi(tmpperms)]
# "catch" permits this to work with Tcl 7.4
catch {fconfigure $fout -translation binary}
_cgi_set_uservar $varname [list $foutname $filename $conttype]
***************
*** 1452,1457 ****
--- 1452,1458 ----
} else {
# read the part into a variable
set val ""
+ set blanks 0
while {1} {
if {-1 == [gets $fin buf]} break
if {[info exists dbg_fout]} {puts $dbg_fout $buf; flush $dbg_fout}
***************
*** 1463,1468 ****
--- 1464,1479 ----
append val \n
}
regexp (.*)\r$ $buf dummy buf
+ if {[info exists blanks]} {
+ if {0!=[string compare $buf ""]} {
+ if {$blanks} {
+ append val [string repeat \n [incr blanks]]
+ }
+ unset blanks
+ } else {
+ incr blanks
+ }
+ }
append val $buf
}
_cgi_set_uservar $varname $val
***************
*** 1482,1488 ****
# save file for debugging purposes
set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]]
set _cgi(input) $dbg_filename
! spawn -open [open $dbg_filename w]
set dbg_sid $spawn_id
}
spawn -open $fin
--- 1493,1499 ----
# save file for debugging purposes
set dbg_filename [file join $_cgi(tmpdir) CGIdbg.[pid]]
set _cgi(input) $dbg_filename
! spawn -open [open $dbg_filename w $_cgi(tmpperms)]
set dbg_sid $spawn_id
}
spawn -open $fin
***************
*** 1579,1585 ****
# read the part into a file
set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]]
! spawn -open [open $foutname w]
set fout_sid $spawn_id
_cgi_set_uservar $varname [list $foutname $filename $conttype]
--- 1590,1596 ----
# read the part into a file
set foutname [file join $_cgi(tmpdir) CGI[pid].[incr _cgi(file,filecount)]]
! spawn -open [open $foutname w $_cgi(tmpperms)]
set fout_sid $spawn_id
_cgi_set_uservar $varname [list $foutname $filename $conttype]
***************
*** 2187,2202 ****
flush $_cgi(mailfid)
! if {[file executable /usr/lib/sendmail]} {
! exec /usr/lib/sendmail -t -odb < $_cgi(mailfile)
! # Explanation:
! # -t means: pick up recipient from body
! # -odb means: deliver in background
! # note: bogus local address cause sendmail to fail immediately
! } elseif {[file executable /usr/sbin/sendmail]} {
! exec /usr/sbin/sendmail -t -odb < $_cgi(mailfile)
! # sendmail is in /usr/sbin on some BSD4.4-derived systems.
! } else {
# fallback for sites without sendmail
if {0==[info exists _cgi(mail_relay)]} {
--- 2198,2215 ----
flush $_cgi(mailfid)
! foreach sendmail in $_cgi(sendmail) {
! if {[file executable $sendmail]} {
! exec $sendmail -t -odb < $_cgi(mailfile)
! # Explanation:
! # -t means: pick up recipient from body
! # -odb means: deliver in background
! # note: bogus local address cause sendmail to fail immediately
! set sent 1
! }
! }
!
! if {0==[info exists sent]} {
# fallback for sites without sendmail
if {0==[info exists _cgi(mail_relay)]} {
***************
*** 2241,2246 ****
--- 2254,2265 ----
set _cgi(mail_relay) $host
}
+ proc cgi_sendmail {path} {
+ global _cgi
+
+ set _cgi(sendmail) $path
+ }
+
##################################################
# cookie support
##################################################
***************
*** 2416,2422 ****
##################################################
proc cgi_stylesheet {href} {
! puts ""
}
proc cgi_span {args} {
--- 2435,2441 ----
##################################################
proc cgi_stylesheet {href} {
! cgi_puts ""
}
proc cgi_span {args} {
***************
*** 2545,2550 ****
--- 2564,2584 ----
}
##################################################
+ # temporary file procedures
+ ##################################################
+
+ # set appropriate temporary file modes
+ proc cgi_tmpfile_permissions {{mode ""}} {
+ global _cgi
+
+ if {[string length $mode]} {
+ set _cgi(tmpperms) $mode
+ }
+
+ return $_cgi(tmpperms)
+ }
+
+ ##################################################
# user-defined procedures
##################################################
***************
*** 2604,2615 ****
--- 2638,2655 ----
switch $tcl_platform(platform) {
unix {
set _cgi(tmpdir) /tmp
+ set _cgi(tmpperms) 0644
+ set _cgi(sendmail) [list /usr/lib/sendmail /usr/sbin/sendmail]
} macintosh {
set _cgi(tmpdir) [pwd]
+ set _cgi(tmpperms) {}
+ set _cgi(sendmail) {}
} default {
set _cgi(tmpdir) [pwd]
catch {set _cgi(tmpdir) $env(TMP)}
catch {set _cgi(tmpdir) $env(TEMP)}
+ set _cgi(tmpperms) {}
+ set _cgi(sendmail) {}
}
}