This reminds me of my highly insecure CGI chat that I have lying around. It has horrible security problems because users can easily impersonate each other and it doesn't escape links or Javascript properly. On the other hand, it's 5 years old already and the security holes were known back then even. Nowadays, I'd clean up the user input using clinton's HTML::StripScripts or something else that limits what kinds of tags you can submit as HTML to the chat. The user authentication would be done as cookies using a secret salt so impersonation couldn't be done by simply by setting a parameter in your request.
I haven't included the templates - if there is large enough interest, I can package up the tree and release it onto CPAN.
package CGI::Chat::Simple; use strict; use URI::Escape; use HTML::Entities; use Tie::File; use POSIX qw(strftime); use base qw[ CGI::Application ]; use vars qw( $VERSION ); $VERSION = '0.01'; =head1 NAME CGI::Chat::Simple - A very simple and insecure webchat =head1 DESCRIPTION This is an instant webchat. =head1 SYNOPSIS =for example begin use strict; use CGI::Chat::Simple; my $chat = CGI::Chat::Simple->new( TMPL_PATH => "templates", )->run; =for example end =head1 METHODS =over 4 =item B<new> =cut sub new { my ($class) = shift; my $self = $class->SUPER::new(@_); $self; }; =item B<setup> The C<setup> method is called by the CGI::Application framework when the application should initialize itself and load all necessary parameters. The wiki decides here what to do and loads all needed valu +es from the configuration or database respectively. These parameters are passed to the wiki via the C<PARAMS> parameter of CGI::Application, as C<setup> is not called directly. So the general use is like this : =for example begin my $wiki = CGI::Wiki::Simple ->new( PARAMS => { # to be done })->run; =for example end C<setup> takes a list of pairs as parameters, one mandatory and some o +ptional : =cut sub setup { my ($self) = @_; $self->run_modes( login => 'render_login', frame => 'render_frame', messages => 'render_messages', users => 'render_users', input => 'render_input', ); $self->mode_param( \&decode_runmode ); $self->start_mode("login"); my $q = $self->query; my %default_config = ( script_name => $q->script_name, ); my %args; $args{$_} = defined $self->param($_) ? $self->param($_) : $default_c +onfig{$_} for (keys %default_config); $self->param( $_ => $args{$_}) for qw( script_name action ); my (@messages); tie @messages,'Tie::File','messages.log' or die "Couldn't tie message database"; $self->param( messages => \@messages ); # Maybe later add the connection to the database here... }; =item B<decode_runmode> C<decode_runmode> decides upon the url what to do. It also initializes the following CGI::Application params : user action message messagecount id =cut sub decode_runmode { my ($self) = @_; my $q = $self->query; my $action = $q->param("action"); # Magic runmode decoding : my %rms = $self->run_modes; my $runmodes = join "|", map { quotemeta } keys %rms; if ($q->path_info =~ m!^/($runmodes)\b!) { $action = $1; $q->param("action",""); }; $action ||= 'login'; $self->param( $_ => $self->query->param($_)) for qw( user action message id messagecount ); my (@seen); tie @seen,'Tie::File','seen.log' or die "Couldn't tie seen database"; my %seen_uniq = map { split "\0" } @seen; if ($self->param('user')) { $seen_uniq{$self->param('user')} = time(); }; @seen = map { $_ . "\0" . $seen_uniq{$_} } grep { time - $seen_uniq{ +$_} < 120 } sort keys %seen_uniq; $self->param( seen => [ sort keys %seen_uniq ]); $action; }; =item B<teardown> The C<teardown> sub is called by CGI::Application when the program ends. Currently, it does nothing in CGI::Wiki::Simple. =cut sub teardown { my ($self) = @_; # Maybe later add the database disconnect here ... }; sub load_tmpl { my ($self,$name) = @_; my $template = $self->SUPER::load_tmpl( $name, die_on_bad_params => +0 ); $template->param($_,$self->param($_)) for qw(script_name user id ); $template; }; sub render { my ($self,$templatename,$actions,@params) = @_; my $template = $self->load_tmpl($templatename); $self->load_actions($template, map { $_ => 1 } @$actions ); $template->param( $_ => $self->param( $_ )) for @params; $template->output; }; sub render_login { my $self = shift; my $template = $self->load_tmpl('login.tmpl'); $template->output; }; sub render_frame { my $self = shift; my $template = $self->load_tmpl('frame.tmpl'); $template->output; }; sub render_input { my $self = shift; if ($self->param('message')) { my $line = join "\0",$self->param('user'),$self->param('message'), +time(); push @{$self->param('messages')}, $line; }; my $template = $self->load_tmpl('input.tmpl'); $template->param(id => time() . rand ); $template->output; }; sub render_messages { my $self = shift; my $template = $self->load_tmpl('messages.tmpl'); my $messagecount = $self->param('messagecount') || 15; my @messages = map { my @arr = split /\0/; { name => $arr[0], message => $arr[1], timestamp => strftime('%Y%m%d-%H:%M:%S',local +time($arr[2])) } } @{$self->param('messages')}; shift @messages while @messages > $messagecount; $template->param( messages => \@messages ); $template->output; }; sub render_users { my $self = shift; my $template = $self->load_tmpl('users.tmpl'); $template->param( users => [ map { { name => $_ } } @{$self->param(' +seen')} ] ); $template->output; }; 1; =head1 AUTHOR Max Maischein (corion@cpan.org) =head1 COPYRIGHT Copyright (C) 2003 Max Maischein. All Rights Reserved. This code is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO perl
In reply to Re: chatterbox like server app (a highly insecure example)
by Corion
in thread chatterbox like server app
by hushhush
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |