#!/bin/bash
#\
exec tclsh "$0" ${1+"$@"}
package require ncgi
proc output {what {mode normal}} {
set debug_p 0
if {$debug_p && ![info exists ::debugFP]} then {
set ::debugFP [open [set filename /tmp/comments.log.[pid]-[clock format [clock seconds] -format "%Y-%m-%d_%H%M%S"]] w]
catch {exec chmod a+r $filename}
foreach var [lsort -dictionary [array names ::env]] {
puts $::debugFP "env($var) := $::env($var)"
}
puts $::debugFP ""
puts $::debugFP [ncgi::query]
puts $::debugFP ""
}
if {$debug_p} then {puts $::debugFP $what}
if {$mode eq "normal" && [catch {puts $what}]} then exit
}
proc debug {what} {
output "\n$what\n" debug
}
#
# Make sure no more than three instances are running at a time
#
set connected_p 0
proc /dev/null {sock args} {catch {close $sock}}
set why ""
for {set port 20001} {$port <= 20003} {incr port} {
if {![catch {socket -server /dev/null $port} problem]} then {
set connected_p 1; break
} else {
append why \n $problem
}
}
if {!$connected_p} then {
catch {ncgi::header}
output "
Server Temporarily Busy
Please resubmit your request again in a minute or two"
exit
}
unset port
unset connected_p
#
# If we reach this point we are one of no more than five instances running
#
proc post.blog {} {
global env adp
set ROOT /var/www/michael/blog.cleverly.com
# Pound does reverse proxying
set env(SERVER_PORT) 80
# Get form variables
array set form [ncgi::nvlist]
debug "Form Variables:\n\n [array get form]"
# Make sure we know what post we were commenting on
if {![info exists form(id)]} then {
debug "No form(id), redirecting to /"
return [catch {ncgi::redirect /}]
}
set form(id) [lindex [split $form(id) "#"] 0]
if {![string is integer -strict $form(id)] || $form(id) <= 0} then {
debug "invalid form(id) of $form(id), redirecting to /"
return [catch {ncgi::redirect /}]
}
set post_id $form(id)
# We only support the POST methods
if {![info exists env(REQUEST_METHOD)] ||
![string equal "POST" [set method $env(REQUEST_METHOD)]]} then {
debug "Non POST request method, redirecting to permalink"
return [catch {ncgi::redirect /permalinks/$post_id.html#comments}]
}
package require blog.cleverly.com
package require md5 1
package require nstcl 1.2
catch {namespace import nstcl::*}
# Make sure this post exists and has already been published
set SQL [format {
select count(*) as qty,
max(posted) as blog_posted_at,
max(title) as blog_title
from blogposts
where post_id = %d
and draft_p = 0
and posted <= '%s'
} $post_id [sysdate -format "%Y-%m-%d %H:%M:%S"]]
# If this isn't public, redirect to the ostensible permalink if existant
# or the home page otherwise
db eval $SQL {} {}
if {$qty == 0} then {
debug "Post does not exist in the database"
if {[file exists $ROOT/permalinks/$post_id.html] &&
[file readable $ROOT/permalinks/$post_id.html]} then {
debug "But does exist on disk, redirecting to permalinks"
return [catch {ncgi::redirect /permalinks/$post_id.html}]
} else {
debug "and does not exist on disk, redirecting to /"
return [catch {ncgi::redirect /}]
}
}
# Comment ID?
debug "Does form(comment_id) exist? [info exists form(comment_id)]"
if {[info exists form(comment_id)]} then {debug "form(comment_id) := $form(comment_id)"}
debug "Does form(comment_id_has) exist? [info exists form(comment_id_hash)]"
if {[info exists form(comment_id)]} then {debug "form(comment_id_hash) := $form(comment_id_hash)"}
if {[info exists form(comment_id)] &&
[info exists form(comment_id_hash)] &&
[string is integer -strict $form(comment_id)]} then {
set new_comment_id $form(comment_id)
set comment_id_hash $form(comment_id_hash)
set expected_hash [blog.hash $new_comment_id]
debug "comment_id_hash := $comment_id_hash\nexpected_hash := $expected_hash"
if {![string equal $comment_id_hash $expected_hash]} then {
debug "bad hash found, redirecting to /err/bad-hash.html?$new_comment_id"
return [catch {ncgi::redirect /err/bad-hash.html?$new_comment_id}]
}
set first_submit_p 0
set existing_post_id [db onecolumn \
"select post_id from comments where comment_id = $new_comment_id"]
# Prevent double-clicks
if {[string is integer -strict $existing_post_id]} then {
debug "Double click detected"
return [catch {ncgi::redirect \
/permalinks/$existing_post_id.html#c$new_comment_id}]
}
} else {
set first_submit_p 1
db eval "begin"
db eval "update sequences set value = round(value + 1) where name='comment_id'"
set new_comment_id [db onecolumn \
"select value from sequences where name='comment_id'"]
db eval "commit"
# insurance kludge against decimals
regexp {^(\d+)} $new_comment_id => new_comment_id
set expected_hash [blog.hash $new_comment_id]
debug "first_submit_p := 1\nnew_comment_id := $new_comment_id\nexpected_hash := $expected_hash"
}
set real_variable_names [list name email url message]
set hash_variable_names [list]
foreach var $real_variable_names {
lappend hash_variable_names [blog.hash "$var $new_comment_id"]
set hash_name_for_$var [lindex $hash_variable_names end]
debug "$var becomes [lindex $hash_variable_names end]"
}
debug "First submit? := $first_submit_p"
if {$first_submit_p} then {
set actual_variable_names $real_variable_names
} else {
set actual_variable_names $hash_variable_names
}
# Our form variables
set preview_p [info exists form(preview)]
debug "preview_p := $preview_p"
foreach real_var $real_variable_names \
hash_var $actual_variable_names {
if {[info exists form($hash_var)]} then {
set $real_var [string trim $form($hash_var)]
debug "$hash_var existed, setting $real_var to submitted value of: [set $real_var]"
} else {
set $real_var ""
debug "$hash_var did not exist, setting $real_var to empty string"
}
}
set debug_txt ""
foreach debug_var [lsort -dictionary [info locals]] {
if {[string match debug* $debug_var]} then continue
if {[array exists $debug_var]} then {
append debug_txt "\n ARRAY $debug_var := [array get $debug_var]"
} else {
append debug_txt "\n SCALAR $debug_var := [list [set $debug_var]]"
}
}
debug "Local variables set are: $debug_txt"
# antispam (unless you are a spammer)
if {[info exists form(fullname)]} then {
set antispam $form(fullname)
} else {
set antispam ""
}
# This will enable us to use ADPs, nstcl, etc. later on
blog.enable-templating
# Keep track of the number of problems
set n_problems 0
# Test for a well-formed email address
set email_valid_re {^[^@<>\"\t ]+@[^@<>\".,_\t\n ]+(\.[^@<>\"\
\\.,\n\t_]+)+$}
if {[string length $email] && ![regexp -- $email_valid_re $email]} then {
incr n_problems
set email_problem "You don't have to provide your email address; but,
if you do, please enter it correctly"
}
set email [string map [list \" """] [ns_quotehtml $email]]
set preview(email) $email
# Test for a well-formed name
debug "Testing for \$name := \"$name\""
if {[string length $name] == 0 ||
[regexp -nocase -- {\w} $name] == 0 ||
[string equal -nocase $name "none"]} then {
incr n_problems
set name_problem "Your name is required for proper attribution"
} elseif {[regexp -- $email_valid_re $name]} then {
incr n_problems
set name_problem "Your parents didn't name you after an email address did they?"
}
set name [string map [list \" """] [ns_quotehtml $name]]
set preview(name) $name
# Test for a well-formed URL
set url_valid_re {(?i)^https?://[^/@:]+((:\d+)?/(\S+)?)?$}
if {[string length $url] && ![regexp -- $url_valid_re $url]} then {
incr n_problems
set url_problem "You don't need to include a URL; but, if you do,
please enter a valid http or https URL"
}
set url [string map [list \" """] [ns_quotehtml $url]]
set preview(url) $url
# Is there a message?
if {[string length $message] == 0} then {
incr n_problems
set message_problem "A comment with no content?\
How does that help anyone?"
set tidied ""
} else {
if {![regexp {<[^<>]+>} $message]} then {
set format text
set tidied
[ns_quotehtml $message]
regsub -all -- {\r?\n\s*\n} $tidied "\n\n
" tidied
} else {
set format html
set tidied $message
}
# Verify it with tidy
package require fileutil
package require tdom
# Write the file to disk
set pid [pid]
set path /var/www/michael/tmp
set fp [open $path/in-$pid.html w]
puts $fp $tidied
close $fp
#file copy $path/in-$pid.html $path/in-$pid.debug
#exec chmod a+r $path/in-$pid.debug
# Have tidy turn it into valid xhtml
catch {
exec tidy -numeric -ascii -asxhtml -quiet -o $path/out-$pid.html \
-f /dev/null < $path/in-$pid.html
}
# Read the tidied results back in, delete the temporary files
set tidied [fileutil::cat $path/out-$pid.html]
#file copy $path/out-$pid.html $path/out-$pid.debug
#exec chmod a+r $path/out-$pid.debug
file delete $path/out-$pid.html
file delete $path/in-$pid.html
# it's easier to use tdom's methods when there are no xmlns declarations
regsub -all -- { xmlns=".+?"} $tidied "" tidied
regexp {^.*(