#!/usr/bin/perl
# cgi-irc v0.2 - http://dgl.cx/irc/
# (C) 2000 David Leadbeater (cgiirc@dgl.cx)
# cgi-irc comes with ABSOLUTELY NO WARRANTY
# This is free software, and you are welcome to redistribute it
# under certain conditions; read the file COPYING for detail
# Some parts of this file have been taken from JIRC an irc bot frame work
# JIRC Jerry's IRC Bot 1.02 -- 2000 July 6 -- Scott "Jerry" Lawrence
use strict;
use vars qw(%config $remote $server_conn $add $default_channel);
$|=1;
use CGI;
use IO::Socket;
use IO::Select;
my $q=new CGI;
my $version="0.1";
my $img="http://dgl.cx/irc/cgiirc.jpg";
sub html;
print $q->header();
print "CGI IRC![\"CGI](\"$img\")
\n";
$config{suppress_server} = 1;
$config{tmpfile_prefix}="/tmp/cgiirc-";
$config{nick}=$q->param('nick') or error("Nickname not set");
$config{name}=$q->param('name') or error("Realname not set");
$config{server}=$q->param('server') or error("Server not set");
$config{port}=$q->param('port') or error("Port not set");
$config{channels}=$q->param('channels') or error("Channels not set");
$config{rand}=$q->param('rand') or error("Random Value not set");
&update_channels;
html("Make sure to quit via /quit");
for(my $i=0;$i < 3;$i++){
connect_to_server($config{server},$config{port});
if($remote){
last
}else{
close $remote;
}
}
open(ADD, ">$config{tmpfile_prefix}$config{rand}");
print ADD "";
close(ADD);
open(ADD, "$config{tmpfile_prefix}$config{rand}");
$add=\*ADD;
my $sel = new IO::Select( $remote, $add);
my(@ready);
while(@ready = $sel->can_read) {
foreach my $fh (@ready) {
if($fh == $remote){
my $tmp=<$fh>;
irc_check_command($tmp);
}elsif($fh == $add){
my $tmp=;
next if $tmp eq "";
chomp($tmp);
if($tmp=~ s/^\///){
slashcmd($tmp);
}else{
irc_server_speech($default_channel, $tmp);
}
}
}
}
sub update_channels{
my $file=$config{tmpfile_prefix}."chan-".$config{rand};
open(CHAN, ">$file");
print CHAN "$config{channels}\n";
close(CHAN);
}
# slash commands
sub slashcmd{
my @args=split(/ /,shift);
my $command=lc(shift(@args));
if($command eq "msg" or $command eq "m"){
my $channel=shift(@args);
my $text=join(" ",@args);
irc_server_speech($channel, $text);
}elsif($command eq "whois" or $command eq "w"){
print $remote "WHOIS $server_conn $args[0]\n";
# while(my $tmp=<$remote>){
# last if($tmp =~ /:End of \/WHOIS list./);
# $tmp=~ /$args[0]\s+(.*?)(\015\012|\012)/i;
# print "*** $1\n";
# }
}elsif($command eq "default" or $command eq "chan"){
if($args[0] =~ /^(#|&)/){
$default_channel=$args[0];
}
}elsif($command eq "l" or $command eq "leave" or $command eq "part"){
my $leave=shift(@args);
if(!$leave){$leave=$default_channel}
$config{channels}=~ s/(^| )\Q$leave\E($| )/ /;
$config{channels}=~ s/(^ | $)//;
print $remote "PART $leave :",join(" ",@args),"\n";
&update_channels;
}elsif($command eq "j" or $command eq "join"){
print $remote "JOIN $args[0]\n";
$config{channels}.=" $args[0]";
&update_channels;
}elsif($command eq "nick"){
$config{nick}=$args[0];
print $remote "NICK $args[0]\n";
}elsif($command eq "me"){
irc_server_emote($default_channel,join(" ",@args));
}elsif($command eq "quit" or $command eq "q"){
my $me=join(" ",@args);
if($me eq ""){$me="CGI IRC -- http://dgl.cx/irc/"}
print $remote "QUIT :",$me,"\n";
sleep(1);
close($add);
close($remote);
print "\n";
unlink("$config{tmpfile_prefix}$config{rand}");
unlink("$config{tmpfile_prefix}"."chan-"."$config{rand}");
}else{
html("*** Unknown command '$command'\n");
}
}
# connection routines
sub connect_to_server{
my($server,$port)=@_;
$server_conn=$server;
$remote = IO::Socket::INET->new( Proto => "tcp",
PeerAddr => $server,
PeerPort => $port,
);
unless ($remote) { die "ERROR: Cannot connect to $server" }
$remote->autoflush(1);
irc_server_raw("NICK", "$config{nick}");
irc_server_raw("USER", "abc localhost localhost :$config{name}");
foreach my $channel (split / /, $config{channels}){
next if (length $channel < 1);
irc_server_raw("JOIN", $channel);
$default_channel=$channel;
}
}
# local display info.
sub server_print{
if ($config{suppress_server} == 0){
html shift;
}
}
# server response parsers
sub irc_server_poll{
my $resp;
$resp=<$remote>;
if($resp){
irc_check_command($resp);
}
}
sub irc_check_command{
my $response = shift;
my ($ctcp_command,$ctcp_params,$remote_nick,$remote_host);
# mega regex to split command into parts
$response =~ /(.*?):(.*?)(:(.*?)|)(\015\012|\012)/;
my ($prefix,$command,$text)=($1,$2,$4);
if ("PING" eq substr $prefix, 0, 4){
print $remote "PONG $command";
} else {
my @bits = split " ", $command;
($remote_nick,$remote_host) = split "!", $bits[0];
if ($bits[1] eq "QUIT"){
# someone quit
html "*** SignOff $remote_nick: $bits[2] ($text)\n";
} elsif ($bits[1] eq "PART"){
# someone left the channel
html "*** $remote_nick $remote_host left $bits[2] ($text)\n";
} elsif ($bits[1] eq "JOIN"){
# someone joined the channel
html "*** $remote_nick $remote_host has joined $text\n";
} elsif ($bits[1] eq "NICK"){
# someone changed their nick
html "*** $remote_nick is now known as $text\n";
} elsif ($bits[1] eq "KICK"){
# someone was kicked.
html "*** $remote_nick kicked $bits[3] on channel $bits[2]: $text\n";
# auto rejoin...
if ( (lc $bits[3]) eq (lc $config{nick}) )
{
# yipe! it was me that was kicked!
irc_server_raw("JOIN", "$bits[2]");
html "*** Auto-Rejoined $bits[2]\n";
}
} elsif ($bits[1] eq "NOTICE"){
# simple notices.
html "*$remote_nick* $text\n";
} elsif ($bits[1] eq "TOPIC"){
# topic change.
html "*** Topic $bits[2] by $remote_nick: $text\n";
} elsif ($bits[1] eq "MODE"){
# someone changed mode.
html "*** mode $bits[2] $bits[3] $bits[4] by $remote_nick\n";
} elsif ($bits[1] eq "PRIVMSG"){
# someone said something
my $msg_channel = lc $bits[2];
if ("\001" eq substr $text, 0, 1){
$text =~ s/^\001//;
$text =~ s/\001$//;
$text =~ s/\010//g;
$text =~ m/^([\w]+)[ ]/;
$ctcp_command = $1;
$ctcp_params = substr $text,
(length $ctcp_command)+1,
length $text;
}
if ($ctcp_command eq ""){
if ($msg_channel eq lc $config{nick}){
private_speech_handler($remote_nick, $text);
} else {
channel_speech_handler($msg_channel,$remote_nick, $text);
}
}else{
if ($ctcp_command eq "ACTION"){
if ($msg_channel eq lc $config{nick}){
private_emote_handler($remote_nick, $ctcp_params);
}else{
channel_emote_handler($msg_channel, $remote_nick, $ctcp_params);
}
}elsif($ctcp_command eq "PING"){
html "CTCP PING from $remote_nick\n";
print $remote "NOTICE $remote_nick :\001PING $ctcp_params\001\n";
}
}
} elsif ($bits[2] eq "$config{nick}"){
server_print "$response";
}elsif($response =~ s/NOTICE.*?://){
html "$response";
} else {
html "??? $response";
}
}
}
################################################################################
# these are some simple subs to communicate back to the server
sub irc_server_raw{
my ($command, $params) = @_;
print $remote "$command $params\n";
irc_server_poll();
}
sub irc_server_speech{
my ($channel,$text) = @_;
if($channel eq $default_channel){
html "<$config{nick}> $text\n";
}elsif($channel =~ /^(#|&)/){
html "<$config{nick} $channel> $text\n";
}else{
html "msg $channel: $text\n";
}
print $remote "PRIVMSG $channel :$text\n";
}
sub irc_server_emote{
my ($channel, $text) = @_;
irc_server_ctcp($channel, "ACTION", $text);
}
sub irc_server_ctcp{
my ($channel, $ctcpcmd, $text) = @_;
irc_server_speech($channel, "" . $ctcpcmd . " " . $text . "");
}
sub irc_server_notice{
my ($nick, $text) = @_;
print $remote "NOTICE $nick :$text\n";
}
sub channel_speech_handler{
my ($channel, $remotenick, $text)=@_;
if($channel eq $default_channel){
html "<$remotenick> $text\n";
}else{
html "<$remotenick $channel> $text\n";
}
}
sub channel_emote_handler{
my($channel,$remotenick,$text) = @_;
html "$remotenick/$channel $text\n";
}
sub private_speech_handler{
my ($remotenick, $text) = @_;
html "-$remotenick- $text\n";
}
sub private_emote_handler{
my ($remote_nick, $text) = @_;
html "-$remote_nick $text\n";
}
sub error{
html("$_[0]");
exit;
}
sub html{
my @text=@_;
foreach my $text(@text){
chomp($text);
$text=~ s/\&/\&/g;
$text=~ s//\>/g;
print "$text
\n";
}
}