2 November, 2005: Sundries

[ Home page | Web log ]

An old joke: Tom and Harry, two employees of the local council, are seen working their way down a certain street. Every ten yards, Fred digs a hole while Harry stands around leaning on his shovel. When Tom has finished, Harry fills the hole up again from the spoil. After watching this performance for some time, a passer-by asks them what's going on. ``Ah,'' says Tom, ``normally, see, there's three of us on this job. I dig the hole, Dick puts the tree in, and Harry fills it up again. But Dick's off sick today, so it's just us two.''

On a related theme, last weekend I went to Wales to help my friends Ed and Becca plant an orchard. This was good fun, although planting an orchard turns out to be bloody hard work. I shall look forward to the first products in five or so years' time, which by itself is a somewhat sobering thought.

Elsewhere, Martin draws to our attention the web log of Neil Harding, who is pretty much the only pro ID cards web logger in Britain. At that rate he'll soon have written as many posts on the subject as I have, though he doesn't seem to be posting a holiday photo to go with each one. Unfortunately, none of his arguments are all that new (or all that good), but still, it's nice to see at least some variety of opinion in the ``'blogosphere''.

The Identity Cards Bill itself has limped forward into the Lords, where it enjoyed its Second Reading; sadly, there's no TheyWorkForYou for the Lords (yet -- Francis and Julian have written the parser, so if you enjoy writing PHP code, there's a project for you), so you have to read it on the wretched Houses of Parliament site. For politics junkies, though, there is one new feature there: semi-real-time Today in the Commons and Lords transcripts. As usual, the quality of debate in the Lords was a bit better than that in the Commons; we shall see what happens there in committee.

And in other politics news, our glorious leaders are to ban smoking in pubs (which serve food). Now, since I detest the smell of cigarette smoke, you might expect me to be in favour of this, but in fact I'm pretty ambivalent, given that most of the pubs I find myself in are either non-smoking already, or sufficiently well-ventilated that cigarette smoke isn't too troubling. Anyway, the argument in support of the thing is that pub (and other) employees oughtn't to be exposed to risks from passive smoking, which seems fair enough.

The policy is being advertised as prohibiting smoking in pubs in which food is served (leading, of course, to the philosophical question of whether pork scratchings are food). As ever with this government, it's worth checking what the proposed legislation actually says. The relevant bits are sections 2, 3 and 4 of the Bill which:

So: the legislation bans smoking in every pub, but we (or, at least, those of you who smoke) are expected to believe a promise from the Minister that she will then allow smoking by order.

If I were very attached to my right to pollute others' air with tobacco smoke, I'd be disinclined to believe that promise, given its source. Others' mileage may vary.

Moving on, I hear that David Blunkett is not going to resign. I haven't been following this story all that closely, so I'm not sure whether his Galbraith score is now one or two. Anyway, I was intrigued to see his statement that he will cause his shares in DNA Bioscience to be sold; I'd always thought the point of these blind trust arrangements was to ensure that the original owner of the shares couldn't influence how they were held/traded/etc. Ho-hum.

Changing subject yet again, there has been various discussion of the suggestion of Thomas Schelling that, if Iran were to make a nuclear bomb, the United States ought to supply the Iranians with devices to secure their bombs from unauthorised use, called (in American terminology) ``PALs'', Permissive Action Links. The argument here is that it's in nobody's interests -- and particularly not the potential targets of the weapons -- for them to fall into the wrong hands. Frankly, given the President of Iran's recent statements it's not obvious that such a bomb wouldn't start off in the wrong hands, but for the moment let's imagine that at least somebody in the Iranian chain of command would not be keen on committing national suicide. In any case, generally speaking you'd expect the owners of nuclear weapons to be quite keen on retaining control over how they were used, so PALs look like a no-brainer.

Now, tied up with Permissive Action Links are ``Environmental Sensing Devices''. The idea here is that if you have (say) a nuclear bomb fastened to a missile, you only want it to explode if the missile has actually been fired, rather than if somebody nicks it or a technician drops the thing on his foot during maintenance. So you wire a bunch of sensors into the thing which make sure that it can't be armed unless it's experienced acceleration from the missile launch, free-fall and near-vacuum at the top of the missile's trajectory, and then deceleration and increasing air pressure as it descends onto its target. This means that if THE TERRORISTS or some Bond supervillain nick a missile warhead, they oughtn't to be able to trivially hot-wire it and make it go bang.

Another thing you can do with ESDs is to make sure that, if the missile malfunctions and, say, falls short, the bomb won't go off. That could help prevent embarrassing international incidents in which country A fires a missile over country B at a target in country C. If the missile goes wrong it would be unfortunate if the warhead went off wherever it lands in country B.

The same thing goes for shooting down missiles. Suppose (and I should warn you that I'm asking you to suppose fairly hard here) that the Americans actually manage to build a working giant-LASER-in-747 which they fly up and down near Iran in the hope of shooting down any missiles which the Iranians might launch. The game here is that you try to blow up the missile while it's still in ``boost phase'' (i.e., while its engine is firing) on the grounds that it's (a) easy to see and (b) relatively vulnerable at this point. This approach does not guarantee that the missile's warhead will be destroyed, but it does guarantee that, if it is not, it will fall short of its target.

So, imagine that -- in the presence of the imaginary LASER gun thingy -- Iran fires a missile at (picks a random example...) Israel. The LASER thingy shoots at it and destroys the booster; the warhead continues on a shorter trajectory in the same direction. That means that it will fall either within Iran, or on one of Turkey, Syria, Iraq, Jordan, Kuwait or Saudi Arabia, depending on where exactly the missile was launched from:

Map of missile trajectories from Iran to Israel

If the Iranian bomb is fitted with environmental sensors which prevent it from going off until it has reached its true target, all well and good. Otherwise... assuming that the warhead is not damaged and does not malfunction, it will explode where it falls.

Now, presumably that wouldn't prevent the Americans from shooting down such a missile, but it might well discourage any American allies in the region from letting them base bits of their anti-missile gadget in their country (for instance, airbases for the carrier plane, or RADARs or whatever).

Scale things up, and consider a bigger missile fired from Iran against a target on the eastern seaboard of the United States. Much of Europe is underneath the possible flight paths:

Map of missile trajectories from Iran to the USA

Again, the same logic applies. If an Iranian missile heading for (say) New York is shot down in boost phase, the warhead will land somewhere short of that (exactly where depends on how soon after launch the missile is shot down; presumably the operators of the anti-missile gadget will try to do this as soon as possible, therefore minimising the distance the warhead travels from its launch site, but will be limited by the line of sight from their aeroplane to the missile). Again, whether or not the warhead could go off when it lands depends largely on decisions the Iranians make.

Presumably the logic here will drive the Iranians not to fit such a safety system to their warheads, and to advertise this fact, in the hope that doing so will deter people whose countries lie between Iran and its enemies from supporting a US anti-missile scheme to whose success they are essential. Even if this doesn't succeed, they haven't lost very much (and gain slightly by, e.g., not having to add additional complex safety features to their nukes). So, I'm not sure I would expect the Iranians to take up an American offer of shiny made-in-the-USA nuclear bomb safety devices.

Anyway, that's the end of this week'd dose of nuclear paranoia. Since I mentioned ID cards above, you get a holiday photo:

Giraffe-painted cranes on the Stockholm waterfront

Update: as Helen points out in the comments, the caption for the above photo should have read ``Giraffe-painted cranes...'', not ``Leopard-painted'' -- now corrected. In other news, if you are in Cambridge tomorrow, there is a Cambridge No2ID meeting in the Regal, from 8pm. And if you're in Norwich on Saturday, please come to the Norwich ID Cards Forum, 10am to 5pm in the United Reform Church on Redwell Street -- Charles Clarke MP especially welcome.

#!/usr/bin/perl -w # # wcomments: # Simple web comments script. Note that this is intended to be used as a SSI. # # Copyright (c) 2004 Chris Lightfoot. All rights reserved. # Email: chris@ex-parrot.com; WWW: http://www.ex-parrot.com/~chris/ # my $rcsid = ''; $rcsid .= '$Id: wcomments,v 1.26 2006/08/05 14:57:04 chris Exp $'; use strict; use Carp; use CGI::Fast; use CGI qw(-no_xhtml -nosticky); use HTML::Entities; use HTML::Sanitizer; use IO::File; use DBI; use DBD::SQLite; use Error qw(:try); use Digest::MD5; use POSIX; use Mail::RFC822::Address; use Mail::Sendmail; use Regexp::Common qw(URI); #CGI::autoEscape(0); $ENV{HOME} = '/home/chris'; #(getpwuid($<))[7]; my $CT = 'text/html; charset=iso-8859-1'; my $dbname = "$ENV{HOME}/private/web/wcomments.sqlite"; my $policy_url = "/~chris/wwwitter/comments-policy.html"; my $article_root = '/home/chris/public_html/wwwitter'; my $article_url = '/~chris/wwwitter'; my $script_url = '/~chris/scripts/display-comments'; # need this because of mod_include flakiness my $secret = '6063cd79186a5817a04391343355b494'; # hey, do I *look* like some kind of cypherweenie? # select_single_row DBH STATEMENT [BINDVALS] # Return in list context the columns returned by performing STATEMENT on DBH # with BINDVALS. sub select_single_row ($$;@) { my ($dbh, $stmt, @binds) = @_; my $x = $dbh->selectall_arrayref($stmt, {}, @binds); throw Error::Simple("statement `$stmt' returned " . scalar(@$x) . " rows in select_single_row, should be 1") unless (@$x == 1); return @{$x->[0]}; } # select_single_value DBH STATEMENT [BINDVALS] # As select_single_row, but return in scalar context the single value returned. sub select_single_value ($$;@) { my ($dbh, $stmt, @binds) = @_; my @x = select_single_row($dbh, $stmt, @binds); throw Error::Simple("statement `$stmt' returned " . scalar(@x) . " columns in select_single_value, should be 1") unless (@x == 1); return $x[0]; } # new_url QUERY [PARAM VALUE]... # Return the URL of the QUERY, with the given changes to PARAMs. sub new_url ($%) { my ($q, %p) = @_; my $q2 = new CGI($q); foreach (keys %p) { if (!defined($p{$_})) { $q2->delete($_); } else { $q2->param($_, $p{$_}); } } # return $q2->url(-absolute => 1, -query => 1); return "$script_url?" . $q2->query_string(); } # create_schema DBH # Set up the database according to the proper schema. sub create_schema ($) { my $dbh = shift; if (select_single_value($dbh, q#select count(*) from sqlite_master where type = 'table' and name = 'comments'#) == 0) { $dbh->do(q# create table comments ( id text not null primary key, -- comment ID, 8 hex digits article text not null, -- article on which comment is rooted refs text not null default '', -- reference list of comment author text not null, -- metadata, content of comment email text not null, link string, date integer not null, ipaddr integer not null, content text not null, -- as HTML visible integer not null default 0 -- should comment be shown? )#); } if (select_single_value($dbh, q#select count(*) from sqlite_master where type = 'index' and name = 'comments_refs_index' and tbl_name = 'comments'#) == 0) { $dbh->do(q# create index comments_refs_index on comments(refs) #); } if (select_single_value($dbh, q#select count(*) from sqlite_master where type = 'table' and name = 'authors'#) == 0) { $dbh->do(q# create table authors ( digest text not null primary key, -- random token status integer not null default 0, -- nonzero means to hold the comment author text not null, email text not null, link text )#); } $dbh->commit(); } # html_head TITLE # Return the top of an HTML page, with the given TITLE. sub html_head ($) { my ($title) = @_; encode_entities($title); return <


EOF } # html_tail # Return the end of an HTML page. sub html_tail () { return <

Comments copyright (c) contributors and available under a Creative Commons License. See also the comments policy.

EOF } sub page_head ($) { my ($title) = @_; encode_entities($title); return < $title


EOF } sub page_tail () { return <

Comments copyright (c) contributors and available under a Creative Commons License. See also the comments policy.

EOF } # error_page QUERY SHORT LONG # Return the HTML for an error page on QUERY, with SHORT and LONG error text. sub error_page ($$$) { my ($q, $short, $long) = @_; return html_head("Error: $short") . $q->p(encode_entities($long)) . html_tail(); } # comment_url DBH ID # Return the URL of a comment. sub comment_url ($$) { my ($dbh, $id) = @_; my $article = select_single_value($dbh, 'select article from comments where id = ?', $id); return "$article_url/$article#wcomment_$id"; } # article_url ARTICLE # Return the URL of an article. sub article_url ($) { my ($art) = @_; return "$article_url/$art"; } # read_data_from_item FILENAME # Read title, date and text from FILENAME. sub read_data_from_item ($) { my $fn = shift; my $F = new IO::File($fn, O_RDONLY) or die "$fn: open: $!"; my $line; my ($title, $date, $text); $text = ""; my $f = 0; while ($line = $F->getline()) { if ($line =~ m##) { # XXX we assume that the subject is already HTML-entity encoded ($title, $date) = ($1, $2); } $f = 0 if ($f && $line =~ m##); $text .= $line if ($f); if ($line =~ m#
#) { $f = 1; $text = ""; } } $F->close(); die "$fn lacks title and date" unless ($title and $date); die "$fn lacks text" unless (defined $text); return ($title, $date, $text); } # article_title ARTICLE # Return the title of an ARTICLE. my %article_title_cache; sub article_title ($) { my ($art) = @_; if (!exists($article_title_cache{$art})) { ($article_title_cache{$art}) = read_data_from_item("$article_root/$art"); } return $article_title_cache{$art}; } # format_one_comment DBH ID AUTHOR EMAIL LINK DATE CONTENT # Return HTML to display a single comment. #sub format_one_comment ($$$$$$$) { sub format_one_comment ($$@) { my ($dbh, $id, $author, $email, $link, $date, $content) = @_; my $html = ''; # Format the date as a string. my $ds; if (abs($date - time) < 24 * 3600) { $ds = strftime('%H:%M', localtime($date)); } elsif (abs($date - time) < 7 * 24 * 3600) { $ds = strftime('%A, %H:%M', localtime($date)); } elsif (abs($date - time) < 365 * 24 * 3600) { $ds = strftime('%A, %e %B %H:%M', localtime($date)); } else { $ds = strftime('%A, %e %B %Y %H:%M', localtime($date)); } $link = "mailto:$email" if (!defined($link)); $html .= sprintf('

Posted by %s, %s (link):

', $id, encode_entities($link), encode_entities($author), $ds, comment_url($dbh, $id)); $html .= "
" . sanitise($content, $email eq 'chris@ex-parrot.com') . "
"; return $html; } # do_format_comments DBH QUERY LIST FIRST LAST # Format comments LIST[FIRST..LAST]. sub do_format_comments ($$$$$); sub do_format_comments ($$$$$) { my ($dbh, $q, $cc, $first, $last) = @_; my $html = ''; my $article = $q->param('article'); for (my $i = $first; $i <= $last; ++$i) { my ($id, $refs, $author, $email, $link, $date, $content) = @{$cc->[$i]}; $html .= "
  • " . format_one_comment($dbh, $id, $author, $email, $link, $date, $content); $html .= sprintf('Reply to this.', encode_entities(new_url($q, mode => 'post', article => $article, replyid => $id))); # Consider whether the following comments are replies to this comment. my $R = "$refs,$id"; my $j; for ($j = $i + 1; $j <= $last && $cc->[$j]->[1] =~ /^$R(,|$)/; ++$j) {} --$j; $html .= "
      " . do_format_comments($dbh, $q, $cc, $i + 1, $j) . "
    " if ($j > $i); $i = $j; $html .= "
  • "; } return $html; } # format_comments QUERY DBH ARTICLE # Return HTML displaying comments on ARTICLE. sub format_comments ($$$) { my ($q, $dbh, $article) = @_; my $html = '
      '; my $cc = $dbh->selectall_arrayref(q(select id, refs, author, email, link, date, content from comments where article = ? and visible <> 0 order by refs || ',' || id, date), {}, $article); $html .= do_format_comments($dbh, $q, $cc, 0, @$cc - 1) . '
    ' . sprintf('

    Post a new comment.

    ', encode_entities(new_url($q, mode => 'post', article => $article, replyid => undef))); return $html; } # sanitise UNTRUSTED [PRIV] # Take UNTRUSTED HTML input, and return (more-or-less) proper HTML. If PRIV is # true, allow some additional privileges (in respect of images). sub sanitise ($;$) { my ($text, $priv) = @_; $priv ||= 0; # Do the blank lines thing. $text =~ s#\r\n#\n#sg; $text =~ s#\n\n+#

    #sg; $text = "

    $text"; our $s; $s ||= new HTML::Sanitizer( a => { href => 1, '*' => 0 }, td => { width => 1, align => 1, '*' => 0 }, th => { width => 1, align => 1, '*' => 0 }, '*' => 0 ); $s->permit( qw( strong em cite table tr td th ul ol li br p blockquote strike sup sub ) ); $s->permit(img => { src => 1, alt => 1, title => 1, '*' => 0}) if ($priv); $text = $s->filter_xml_fragment($text); # Drop any empty tags. $text =~ s#<([^/][^>]*)>(\s*)#$2#sg; # Turn XHTML to HTML. Uses _xml_ above so that we always get close tags. # God what a nightmare this is. $text =~ s# />#>#g; # This *really* shouldn't be necessary. decode_entities($text); return $text; } # $allowed_html_blurb # Description of what can be done with HTML. my $allowed_html_blurb = <Allowed HTML

    Blank lines in your comment will be converted into paragraph breaks. You can also use any of the following HTML:

    • <strong>strong</strong>
    • <em>emphasised<em>
    • <cite>citation</cite>
    • <strike>struck out</strike>
    • <a href="http://www.google.com/">link</a>
    • Line <br>
    • <sup>super</sup>script
    • <sub>sub</sub>script



    I returned and saw under the sun, that the race is not to the swift, nor the battle to the strong, neither yet bread to the wise, nor yet riches to men of understanding, nor yet favour to men of skill; but time and chance happeneth to them all.




    • <li>item</li>
    • <li>item</li>



    1. <li>item</li>
    2. <li>item</li>




    <tr> <th> Heading 1 </th> <th> Heading 2 </th> </tr>
    <tr> <td> Data 1 </td> <td> Data 2 </td> </tr>


    EOF # timestamp TIME # Return a textual timestamp. sub timestamp ($) { my ($t) = @_; return strftime('%H:%M, %A, %e %B %Y', localtime($t)); } # unws STRING # Strip whitespace from start and end of STRING. sub unws ($) { $_[0] =~ s/^\s+//; $_[0] =~ s/\s+$//; } # magic_number [N] # Generate or, if N is supplied, check a magic number. sub magic_number (;$) { if (@_) { my $n = shift; return 0 if (!defined($n) || $n !~ /^[0-9a-f]{6}$/i); return substr($n, 3) eq substr(Digest::MD5::md5_hex("$secret\0" . substr($n, 0, 3)), 0, 3); } else { my $n = sprintf('%03x', int(rand(0x1000))); return $n . substr(Digest::MD5::md5_hex("$secret\0$n"), 0, 3); } } # post_comment_form QUERY DBH ARTICLE AUTHORDIGEST # Return HTML displaying a form for posting a new comment. Modifies # AUTHORDIGEST to give a new cookie. sub post_comment_form ($$$$) { my ($q, $dbh, $article, $authordigest) = @_; my $html = ''; # If the author hasn't specified the name, see if their cookie is in the # database. my ($c_author, $c_email, $c_link) = $dbh->selectrow_array('select author, email, link from authors where digest = ?', {}, $authordigest) if (defined($authordigest)); my $author = $q->param('author'); $author = $c_author || '' unless (defined($author)); my $email = $q->param('email'); $email = $c_email || '' unless (defined($email)); my $link = $q->param('link'); $link = $c_link || '' unless (defined($link));; my $replyid = $q->param('replyid') || ''; throw Error::Simple("bad reply id $replyid") if ($replyid ne '' and select_single_value($dbh, 'select count(*) from comments where id = ? and visible <> 0', $replyid) != 1); my $magic_number = $q->param('magic_number'); unws($author); unws($email); unws($link); $author =~ s#\s+# #g; $q->param('author', $author); $q->param('email', $email); $q->param('link', $link); $q->param('article', $article); $q->param('replyid', $replyid); my $linkerror = ''; $linkerror = '
    If you give a web page link, it should be a full URL starting http://.' if ($link ne '' and $link !~ $RE{URI}{HTTP}{-scheme => qr/https?/}); my $emailerror = ''; $emailerror = '
    You must give a valid email address.' if (!Mail::RFC822::Address::valid($email)); my $text = $q->param('text'); $text ||= ''; $q->param('text', $text); # $html .= $q->p('Please read the', $q->a({ href => $policy_url }, 'comments policy'), 'before posting'); $html .= $q->p($q->strong('Commenters are reminded that they must read and agree to the ', $q->a({ href => $policy_url }, 'comments policy'), 'before posting. In particular, to have your comment posted, you must: write something interesting; give your full real name and email address; and avoid errors of grammar and orthography.')); if ($replyid ne '') { $html .= $q->p($q->em('This is the comment to which you are replying:')) . $q->blockquote(format_one_comment($dbh, $replyid, $dbh->selectrow_array('select author, email, link, date, content from comments where id = ?', {}, $replyid))); } if (!defined($q->param('counter'))) { $q->param('counter', 0); } else { $q->param('counter', int($q->param('counter')) + 1); $html .= $q->h3("Previewing your comment") . $q->p('Not yet posted by', $q->strong( $q->a({ href => ($link ? $link : "mailto:$email") }, $author) ) . ':') . $q->div(sanitise($text, ($email eq 'chris@ex-parrot.com' ? 1 : 0))); } $q->param('counter', 0) unless ($emailerror eq '' and $linkerror eq '' and $text =~ /[^\s]/); if ($emailerror eq '' and $linkerror eq '') { my $newdigest = Digest::MD5::md5_hex("$secret\0$author\0$email\0$link"); $dbh->do('delete from authors where digest = ?', {}, $newdigest); $dbh->do('insert into authors (digest, author, email, link) values (?, ?, ?, ?)', {}, $newdigest, $author, $email, $link); $dbh->commit(); $authordigest = $_[3] = $newdigest; } unless ($q->param('Post') and $q->param('counter') > 0 and magic_number($magic_number)) { # Don't have enough information to post the comment yet; return a form # for the user to fill out. $magic_number = magic_number() if (!magic_number($magic_number)); $html .= $q->start_form(-method => 'post', -action => $q->url(-absolute => 1)) . $q->hidden(-name => 'mode') . $q->hidden(-name => 'counter') . $q->hidden(-name => 'article') . $q->hidden(-name => 'replyid', -default => '') . $q->start_table({ style => 'width: 100%' }) . $q->Tr($q->th('Name'), $q->td($q->textfield({ name => 'author', size => 25 }))) . $q->Tr($q->th('Email'), $q->td($q->textfield({ name => 'email', size => 25 }), $emailerror)) . $q->Tr($q->th('Web page'), $q->td($q->textfield({ name => 'link', size => 25}), $linkerror)) . $q->Tr($q->th({ colspan => 2 }, 'Comment')) . $q->Tr($q->td({ colspan => 2 }, $q->textarea({ name => 'text', style => 'width: 100%', columns => 40, rows => 25 }))) . ($q->param('counter') > 0 ? $q->Tr($q->th("Magic number"), $q->td($q->textfield({ name => 'magic_number', size => 25}), $q->br(), "(The magic number is $magic_number)")) : '') . $q->end_table() . $q->submit({ -name => 'Preview', -value => 'Preview' }) . " " . ($q->param('counter') > 0 ? $q->submit({ -name => 'Post', -value => 'Post' }) : '') . $q->end_form() . $allowed_html_blurb; } else { # Have information to post a comment; do so. my $doemail = 1; my $status = select_single_value($dbh, 'select status from authors where digest = ?', $authordigest); $status ||= 0; $html = $q->p( 'We have now disabled comments to Chris\'s weblog, since for some time the only new contributions have been comment spam. Please contact us if you would like something to be added.'); if (0) { $status = 1 if ($article =~ m#^20040909#); if ($article eq '20040705-where_theres_muck.html' || $text =~ /TARRIFIC/) { $status = 1; $doemail = 0; } elsif ($author eq 'engine marketing search') { $status = 1; $doemail = 0; } elsif ($author =~ /De[rs]o?lo?p\d*|Deofl|Sweedrjj|Nerol|Cseloplj\d*/ || $text =~ /(rolex|vicodin|levitra|xanax)/i || $text =~ /(airlinetickets|really cheap airline)/i || $text =~ /(tramado[ln]|air-conditioning-review)/i) { $status = 1; $doemail = 1; } my $refs = ''; if ($replyid ne '') { $refs = select_single_value($dbh, 'select refs from comments where id = ?', $replyid) || ''; $refs .= ",$replyid"; } $link = undef if ($link eq ''); my $id = sprintf('%08x', select_single_value($dbh, 'select count(*) from comments') + 100); $dbh->do('insert into comments (id, article, refs, author, email, link, date, ipaddr, content, visible) values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)', {}, $id, $article, $refs, $author, $email, $link, time(), $q->remote_host(), $text, ($status == 0 ? 1 : 0)); $dbh->commit(); $html = $q->p('Thank you for your comment. You can view it', $q->a({ href => comment_url($dbh, $id) }, 'here') . '.'); my $extra = ''; if ($status != 0) { $extra = 'Comment has been HELD.'; } my $showlink = "http://ex-parrot.com/~chris/scripts/display-comments?mode=show;id=$id;s=" . Digest::MD5::md5_hex("$secret\0show\0$id"); my $hidelink = "http://ex-parrot.com/~chris/scripts/display-comments?mode=hide;id=$id;s=" . Digest::MD5::md5_hex("$secret\0hide\0$id"); # Notify me about the comment. my $commlink = comment_url($dbh, $id); $link ||= ''; if ($doemail) { sendmail( From => 'wcomments@ex-parrot.com', To => 'cl-wcomments@ex-parrot.com', Subject => 'New comment posted by ' . $author, 'Message-ID' => sprintf('', time(), int(rand(0xffffffff)), int(rand(0xffffffff))), Message => < $link http://ex-parrot.com$commlink Show: $showlink Hide: $hidelink $text $extra EOF } } } return $html; } my $dbh = DBI->connect("dbi:SQLite:$dbname", undef, undef, { AutoCommit => 0, RaiseError => 1 }); create_schema($dbh); while (my $q = new CGI::Fast()) { # $q->autoEscape(0); try { my $authordigest = $q->cookie('wcomments_author'); if (defined($authordigest) and (length($authordigest) != 32 or $authordigest =~ /[^0-9a-f]/i)) { $authordigest = undef; } my $mode = $q->param('mode'); throw Error::Simple("no mode specified") if (!defined($mode)); my $article; if ($mode !~ /^(recent|show|hide)$/) { # To which article are we looking at comments? Sanity-check it. $article = $q->param('article'); throw Error::Simple("no article specified") if (!defined($article)); $article =~ s#.*/([^/]+\.html$)#$1#; throw Error::Simple("bad article \"$article\"") if (!-e "$article_root/$article" || $article !~ /^(\d{8})-/ );#|| $1 < '20040201'); } # Five modes: show a link with the number of comments to be displayed; # show the comments; show complete HTML pages with facility to post # a comment; report recently-made comments; or show or hide a comment. if ($mode eq 'commentslink') { # Link to article, showing number of comments. print $q->header(-type => $CT); my $ncomms = select_single_value($dbh, 'select count(*) from comments where article = ? and visible <> 0', $article); print $q->p($q->a({ href => "$article#wcomments" }, "Comments"), ($ncomms > 0 ? sprintf("(%d so far)", $ncomms) : "")); } elsif ($mode eq 'comments') { # Show comments. print $q->header(-type => $CT), html_head('Comments'), '', format_comments($q, $dbh, $article), html_tail(); } elsif ($mode eq 'post') { # Post a comment or reply. if (select_single_value($dbh, 'select count(*) from ipbans where ipaddr = ?', $q->remote_host()) > 0) { print $q->header(-type => $CT, -status => 500), page_head("Error"), $q->p('Unfortunately, an error has occured. Please try again later.'), page_tail(); } else { my $f = post_comment_form($q, $dbh, $article, $authordigest); print $q->header(-type => $CT, -cookie => $q->cookie( -name => 'wcomments_author', -value => $authordigest, -expires => '+365d')), page_head("Post comment"), $q->p( 'We have now disabled comments to Chris\'s weblog, since for some time the only new contributions have been comment spam. Please contact us if you would like something to be added.'), page_tail(); } } elsif ($mode eq 'recent') { # XXX should only show one element for each article-author tuple. my $x = $dbh->selectall_arrayref( 'select id, author, article from comments where visible = 1 order by date desc limit 6'); print $q->header(-type => $CT), "
      "; foreach (@$x) { my ($id, $author, $article) = @$_; print $q->li($q->a({ href => comment_url($dbh, $id) }, encode_entities($author)), "on", $q->a({ href => article_url($article) }, article_title($article))); } print "
    "; } elsif ($mode =~ /^(show|hide)$/) { my $id = $q->param('id'); my $s = $q->param('s'); throw Error::Simple("Missing parameter") if (!defined($id) || !defined($s)); throw Error::Simple("Permission denied") unless ($s eq Digest::MD5::md5_hex("$secret\0$mode\0$id")); $dbh->do('update comments set visible = ? where id = ?', {}, ($mode eq 'show' ? 1 : 0), $id); $dbh->commit(); my $verb = ($mode eq 'show' ? 'made visible' : 'hidden'); print $q->header(-type => $CT), $q->start_html("Comment $id $verb"), $q->p("Comment $id $verb"), $q->end_html(); } else { throw Error::Simple("bad mode \"$mode\""); } } catch Error::Simple with { my $E = shift; print $q->header(-type => $CT), error_page($q, "Comments error", $E->text()); $dbh->rollback(); }; $dbh->rollback(); # DBD::SQLite bug } $dbh->disconnect();

    Copyright (c) 2005 Chris Lightfoot; available under a Creative Commons License.