Chat with us!

#!/usr/bin/perl -Tw $|++; use strict; use CGI qw(:standard escapeHTML); use HTTP::Daemon; use HTTP::Status; use URI::Find; ## config my $PORT = 42001; # at what port my $TIMEOUT = 90; # number of quiet seconds before abort my $CHAT_TIME_MAX = 300; # how long to keep old scrollback my $CHAT_COUNT_MAX = 12; # how many messages max my $NAME_MAX = 30; # how long can a name be my $MESS_MAX = 120; # how long can a message be ## end config my ($HOST) = $ENV{SERVER_NAME} =~ /(.*)/s; # untaint my $d = do { local($^W) = 0; new HTTP::Daemon (LocalAddr => $HOST, LocalPort => $PORT, Reuse => 1) }; my $url = "http://$HOST:$PORT"; print header; # durn - no shortcuts for this! what was lincoln thinkin'? :) print <Chat with us! END exit 0 unless defined $d; # do we need to become the server? defined(my $pid = fork) or die "Cannot fork: $!"; exit 0 if $pid; # I am the parent close(STDOUT); my @CHAT; { alarm($TIMEOUT); # (re-)set the deadman timer my $c = $d->accept or redo; # $c is a connection my $r = $c->get_request; # $r is a request close $c, redo unless $r; # not sure why I need this (my $code = $r->url->epath) =~ s{^/}{}; $c->send_basic_header; $CGI::Q = new CGI $r->content; print $c header; # start_html is inside switch if (my ($secs) = $code =~ /read(\d+)/) { print $c start_html(-head => [""]); print $c h1("Chat responses"), "Change update to"; print $c " ",a({-href => "$url/read$_"}, $_) for qw(1 2 5 10 15 30 60); print $c " seconds", br; shift @CHAT while @CHAT > $CHAT_COUNT_MAX or @CHAT and $CHAT[0][0] < time - $CHAT_TIME_MAX; print $c table( {-border => 0, -cellspacing => 0, -cellpadding => 2 }, map { Tr(td([substr(localtime($_->[0]),11,8).' from '. fix($_->[1]).':', fix($_->[2],1) ]))} @CHAT); } elsif ($code =~ /write/) { if (defined(my $name = param('name')) and defined(my $message = param('message'))) { # we have input! tr/\x00-\x1f//d for $name, $message; # remove nasties $name = substr($name, 0, $NAME_MAX) if length $name > $NAME_MAX; $message = substr($message, 0, $MESS_MAX) if length $message > $MESS_MAX; push @CHAT, [time, $name, $message] if length $name and length $message; } print $c start_html, h1("Chat write"); print $c start_form(-action => "$url/write"); print $c textfield("name","[I must change my name]", $NAME_MAX), submit("says:"), textfield("message", "", $MESS_MAX, $MESS_MAX, 1); print $c end_form; } print $c end_html; close $c; redo; } sub fix { # HTML escape, plus find URIs if $_[1] local $_ = shift; return escapeHTML($_) unless shift; # use \001 as "shift out", "shift in", presume data doesn't have \001 find_uris($_, sub {my ($uri, $text) = @_; qq{\1\1$text\1\1} }); s/\G(.*?)(?:\001(.*?)\001)?/escapeHTML($1).(defined $2 ? $2 : "")/eig; $_; }