diff options
author | toma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da> | 2009-11-25 17:56:58 +0000 |
---|---|---|
committer | toma <toma@283d02a7-25f6-0310-bc7c-ecb5cbfe19da> | 2009-11-25 17:56:58 +0000 |
commit | bcb704366cb5e333a626c18c308c7e0448a8e69f (patch) | |
tree | f0d6ab7d78ecdd9207cf46536376b44b91a1ca71 /ksirc/dsirc | |
download | tdenetwork-bcb704366cb5e333a626c18c308c7e0448a8e69f.tar.gz tdenetwork-bcb704366cb5e333a626c18c308c7e0448a8e69f.zip |
Copy the KDE 3.5 branch to branches/trinity for new KDE 3.5 features.
BUG:215923
git-svn-id: svn://anonsvn.kde.org/home/kde/branches/trinity/kdenetwork@1054174 283d02a7-25f6-0310-bc7c-ecb5cbfe19da
Diffstat (limited to 'ksirc/dsirc')
-rwxr-xr-x | ksirc/dsirc | 2721 |
1 files changed, 2721 insertions, 0 deletions
diff --git a/ksirc/dsirc b/ksirc/dsirc new file mode 100755 index 00000000..c6e0b63c --- /dev/null +++ b/ksirc/dsirc @@ -0,0 +1,2721 @@ +#!/usr/bin/perl + +# dsirc: dumb-mode small irc client in perl +# by orabidoo <roger.espel.llima@pobox.com> +# +# Copyright (C) 1995-1997 Roger Espel Llima +# +# for a full-screen termcap interface, use this with ssfe +# +# use: dsirc [options] [nick [server[:port[:password]]]] +# options are: +# -p = specify port number +# -i = specify IRCNAME +# -n = specify nickname (quite useless as an option) +# -s = specify server (quite useless as an option) +# -l = specify file to be loaded instead of ~/.sircrc.pl +# -L = specify file to be loaded instead of ~/.sircrc +# -H = specify virtual host to bind to +# -q = don't load ~/.sircrc or ~/.sircrc.pl +# -Q = don't load system sircrc or sircrc.pl +# -R = run in restricted (secure) mode +# -r = raw mode (no control-char filtering) +# -8 = 8-bit mode +# -S = connect using SSL + +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation. See the file LICENSE for more details. +# +# If you make improvements to sirc, please send me the modifications +# (context diffs appreciated) and they might make it to the next release. +# +# For bug reports, comments, questions, email roger.espel.llima@pobox.com +# +# You can always find the latest version of sirc at the following URL: +# http://www.eleves.ens.fr:8080/home/espel/sirc/sirc.html + +# Concerning the use in ksirc you'll find a mail from the author below: +# +# Subject: Re: dsirc in kde +# Date: Thu, 7 Sep 2000 13:16:30 -0400 +# From: Roger Espel Llima <espel@iagora.net> +# To: Harri Porten <porten@kde.org> +# +# On Thu, Sep 07, 2000 at 07:12:33PM +0200, Harri Porten wrote: +# [....] +# > Ok. Your dsirc script is used in ksirc. I haven't checked how it is +# > invoked and what legal ramifications that would have licensing wise but +# > I would like to "officially" ask you anyway: +# > +# > Do you have oppose to your code being used this way in the past and in +# > the future ? Do you "forgive" us [for use in prev. versions of KDE] ? :) +# +# I "officially" find it perfectly fine that dsirc is used in KDE. I knew +# of ksirc when it started, and found it very flattering that someone +# would write 200k of C++ to interface with my 62k of perl :=) + +$version='2.211'; +$date='10 Mar 1998'; +$add_ons=''; + +$libdir=$ENV{"SIRCLIB"} || "."; +push(@INC, $libdir, $ENV{"HOME"}); +@loadpath=($ENV{"HOME"}."/.sirc", $libdir, "."); +$ENV{"SIRCWAIT"} or $ready=1; + +$|=1; + +$publicAway = 1; + +if (!eval "require 'getopts.pl';") { + print "\n\n\ +Your perl interpreter is *really* screwed up: the getopts.pl library is not +even there! Have you even bothered to run 'install'?\n"; + exit; +} + +if ($] >= 5 && (eval "use Socket;", $@ eq '')) { + $sock6 = eval ("require Socket6;") and eval("use Socket6;"); +} elsif (-f "$libdir/sircsock.ph") { + do "$libdir/sircsock.ph"; +} elsif (-f $ENV{'HOME'}."/sircsock.ph") { + do $ENV{'HOME'}."/sircsock.ph"; +} elsif (!eval "require 'sys/socket.ph';") { + print "\n\n\ +Your perl installation is wrong somewhere, the sys/socket.ph include file +couldn't be found. Have you even bothered to run 'install'?\n"; + exit; +} + +$hasPOSIX = 1; +eval "use POSIX;"; +if($@) { + $hasPOSIX = 0; + print "*** No Posix library, falling back to blocking IO (dcc will suck)\n"; +} + + +&Getopts('n:s:p:u:i:l:L:H:rqQR78S'); + +%set=("LOGFILE", "", "LOG", "off", "PRINTUH", "none", "PRINTCHAN", "off", + "LOCALHOST", "", "CTCP", "noflood", "SENDAHEAD", 4096, + "USERINFO", "", "FINGER", "", "IRCNAME", "", "EIGHT_BIT", "on", + "LOADPATH", join(":", @loadpath), "CTRL_T", "/next"); + +$raw_mode=$opt_r || (!-t STDOUT); +$ansi=!$raw_mode && $ENV{"TERM"} =~ /^vt|^xterm|^ansi/i; +$server=$opt_s || $ARGV[1] || $ENV{"SIRCSERVER"} || $ENV{"IRCSERVER"} || + "irc.primenet.com"; +$port0=$opt_p || $ENV{"SIRCPORT"} || $ENV{"IRCPORT"} || 6667; +$username=$opt_u || $ENV{"SIRCUSER"} || $ENV{"IRCUSER"} || (getpwuid($<))[0] || + $ENV{"USER"} || "blah"; +$set{"IRCNAME"}=$opt_i || $ENV{"SIRCNAME"} || $ENV{"IRCNAME"} || "sirc user"; +$nick=$opt_n || $ARGV[0] || $ENV{"SIRCNICK"} || $ENV{"IRCNICK"} || $username; +$set{"FINGER"}=$ENV{"IRCFINGER"} || "keep your fingers to yourself"; +$set{"USERINFO"}=$ENV{"USERINFO"} || "yep, I'm a user"; +if ($server =~ /^\[([^\]]+)\]:([0-9]*):?([^:]*)$/ + or $server =~ /^([^:]+):([0-9]*):?([^:]*)$/) +{ + ($server, $port, $pass)=($1, $2, $3); +} +$port || ($port=$port0); +$server0=$server1=$server; +$port0=$port1=$port; +$pass0=$pass1=$pass; +$initfile=$opt_l || $ENV{"SIRCRCPL"} || $ENV{'HOME'}."/.sircrc.pl" + if $opt_l || !$opt_q; +$sysinit=$libdir."/sircrc.pl" if $libdir ne '.' && !$opt_Q; +$rcfile=$opt_L || $ENV{"SIRCRC"} || $ENV{'HOME'}."/.sircrc" + if $opt_L || !$opt_q; +$sysrc=$libdir."/sircrc" if $libdir ne '.' && !$opt_Q; +$set{"LOGFILE"}=$logfile=$ENV{'HOME'}."/sirc.log"; +$opt_8 || ($set{"EIGHT_BIT"}="off"); +$restrict=$opt_R; +$set{"LOCALHOST"}=$opt_H || $ENV{"SIRCHOST"} || $ENV{"IRCHOST"} || + $ENV{"LOCALHOST"} || ""; +$SSL=$opt_S; + +@ARGV=(); # ignore any more arguments + +if (open(H, "$libdir/sirc.help") || ((-f "$libdir/sirc.help.gz") && + open(H, "gzip -cd $libdir/sirc.help.gz |"))) { + @help=<H>; + close H; + foreach (@help) { + chop; + s/\$version/$version/g; + s/\$date/$date/g; + } +} else { + print "*** Warning: help file ($libdir/sirc.help) not found!\n"; +} +$floodtimer=0; + +sub exit { + &dohooks("quit"); + &sl("QUIT :using sirc version $version$add_ons") if $connected; + close LOG if $logging; + exit 0; +} + +$SIG{'PIPE'}='IGNORE'; +$SIG{'QUIT'}='IGNORE'; +$SIG{'INT'}='exit'; +$SIG{'TERM'}='exit'; # KSIRC MOD + +sub eq { + local($a, $b)=@_; + $a =~ tr/A-Z/a-z/; + $b =~ tr/A-Z/a-z/; + return ($a eq $b); +} + +sub tilde { + $_[0] =~ s|^\~(\w+)|(getpwnam($1))[7]|e; + $_[0] =~ s/^\~/$ENV{'HOME'}/; + $_[0]="." if $_[0] eq ''; +} + +sub sigquit { + # really ugly hack, but it works... + &dohooks("quit"); + close($trysock); +} + +sub resolve { + if ($sock6) { + my $addr = $_[0]; + if ("$addr" =~ /^\d+$/) + { + $addr = pack("N", $addr); + my @i = unpack("C4", $addr); + $addr = "$i[0].$i[1].$i[2].$i[3]"; + } + return getaddrinfo($addr, $_[1], $_[2] || &AF_UNSPEC, &SOCK_STREAM); + } + my $addr; + if ($_[0] =~ /^\d+$/) { + $addr = pack("N", $_[0]+0); + } elsif ($_[0] =~ /^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { + $addr = pack("c4", $1, $2, $3, $4); + } else { + $addr=(gethostbyname($_[0]))[4]; + return -1 unless (defined($addr)); + } + return (&AF_INET, &SOCK_STREAM, 0, pack_sockaddr_in($_[1], $addr), undef); +} + +$nextfh="sircblah000"; +sub newfh { + return ++$nextfh; +} + +sub connect { + $_[0]=&newfh; + local($fh, $host, $port)=@_; + my @res = resolve($host, $port); + &tell("*\cbE\cb* Hostname `$host' not found"), return -1 if scalar(@res) < 5; + $family = -1; + my $bindfailed; + while (scalar(@res) >= 5) { + ($family, my ($socktype, $proto, $addr), undef, @res) = @res; + &print("*\cbE\cb* Out of file descriptors: $!"), return -2 + unless socket($fh, $family, $socktype, $proto); + + $bindfailed = undef; + if ($set{"LOCALHOST"}) { + # once again, DCC only does ipv4 + $bindaddr = (&resolve($set{"LOCALHOST"}, 0, &AF_INET))[3]; + $bindfailed = 1 unless bind($fh, $bindaddr); + } + + $trysock=$fh; + $SIG{'QUIT'}='sigquit'; + $SIG{'QUIT'}='IGNORE', last if connect($fh, $addr); + $SIG{'QUIT'}='IGNORE'; + $family = -1; + } + &print("*\cbE\cb* Can't connect to host: $!"), return -3 if $family == -1; + # Tried to just check for $family != &AF_INET where needed, but + # that segfaulted perl (!), guess it's a bug in Socket6.pm, but I won't try + # to debug that. (malte) + $ipv6 = 1 if ($sock6 && $family == &AF_INET6); + &tell("*\cbE\cb* Warning: can't bind to sirc host: ".$set{'LOCALHOST'}) + if $bindfailed; + + if ($ipv6 != 1) + { + $bindaddr=getsockname($fh) unless $bindaddr; + } + select($fh); $|=1; select(STDOUT); + return 1; +} + +sub connectSSL { + eval "use IO::Socket::SSL;"; + + if($@){ + &tell("Can't load SSL socket library, perl does not support SSL!"); + &tell("To use SSL you must install the IO::Socket::SSL perl library"); + &tell("Try as root: perl -MCPAN -e 'install IO::Socket::SSL'"); + &tell("Giving up connect"); + return 0; + } + local($fh, $host, $port)=@_; + &tell("*** Doing SSL server connect..."); + $fh = new IO::Socket::SSL("$host:$port"); + if(defined $fh){ + $_[0] = $fh; + select($fh); $|=1; select(STDOUT); + return 1; + } + else { + warn "*** I encountered a problem: ($!) ", + &IO::Socket::SSL::errstr(); + warn "*** Invalid hostname or port?\n"; + return -1; + } +} + +sub sel_nbconnecthandler { + local($fh) = $_[0]; + &remwsel($fh); + $!=""; + my $res = unpack("i", getsockopt("$fh", SOL_SOCKET(), SO_ERROR()) || die "Failed to get sockopt: $!"); + select($fh); $|=1; select(STDOUT); + &{$nbconnectlist{$fh}{"callback"}}($fh, $res); + $nbconnectlist{$fh} = undef; +} + +# +# Non blocking connect +# arguments are: filehandle(returned), host, port, callback function. +# + +sub connectnb { + if($hasPOSIX == 0){ + my $cb = $_[3]; + $_[3] = undef; + my $ret = &connect(@_); + if($ret == 1){ + &$cb($_[0], 0); + } + else { + &$cb($_[0], -1); + } + return $ret; + + } + $_[0]=&newfh; + local($fh, $host, $port, $callback)=@_; + my @res = resolve($host, $port); + &tell("*\cbE\cb* Hostname `$host' not found"), return -1 if scalar(@res) < 5; + + while (scalar(@res) >= 5) { + ($family, my ($socktype, $proto, $addr), undef, @res) = @res; + &print("*\cbE\cb* Out of file descriptors: $!"), return -2 + unless socket($fh, $family, $socktype, $proto); + + fcntl($fh, F_SETFL(), O_NONBLOCK()); + &addwsel($fh, "nbconnecthandler", 0); + if(connect($fh, $addr)){ + &$callback($fh, 0); + } + else { + if($! == EINPROGRESS()){ + $nbconnectlist{$fh}{"callback"} = $callback; + } + else { + &print("*\cbI\cb* got other error $!"); + return -1; + } + } + } + return 1; +} + +sub listen { + $_[0]=&newfh; + local($fh, $port)=@_; + local($thisend); + + &tell("\cbE\cb* first set your ipv4 hostname with /set LOCALHOST <hostname>"), return 0 + unless (length $bindaddr); + + +# XXX: don't use ipv6 for the time being as ipv6 and dcc don't mix +# if ($ipv6) { + # XXX: substr() hack to avoid problems on some Linux systems +# (undef, my $addr) = unpack_sockaddr_in6(substr($bindaddr, 0, 24)); +# $thisend = pack_sockaddr_in6($port, $addr); +# } else { + (undef, my $addr) = unpack_sockaddr_in($bindaddr); + $thisend = pack_sockaddr_in($port, $addr); +# } + &tell("*\cbE\cb* Out of file descriptors"), return 0 + unless socket($fh, &AF_INET, &SOCK_STREAM, 0); + &tell("*\cbE\cb* Can't bind local socket!"), close $fh, return 0 + unless bind($fh, $thisend); + &tell("*\cbE\cb* Can't listen to socket!"), close $fh, return + unless listen($fh, 5); + $ipv6=0; + return getsockname($fh); +} + +sub accept { + $_[0]=&newfh; + return (accept($_[0], $_[1]), close($_[1]))[0]; +} + +sub bindtoserver { + @channels=(); $talkchannel=''; + %mode=(); $umode=''; %limit=(); %haveops=(); %chankey=(); $away=''; + $listmin=0; $listmax=100000; $listpat=''; + @waituh=(); @douh=(); @erruh=(); $invited=''; + &dostatus; + &tell("*** Connecting to $server, port $port..."); + if($SSL == 1){ + sleep 10, &bindtoserver if &connectSSL($S, $server, $port) < 0; + } else { + sleep 10, &bindtoserver if &connect($S, $server, $port) < 0; + } + $connected=1; + $server1=$server; + $port1=$port; + $pass1=$pass; + &sl("PASS $pass") if $pass; + &sl("USER $username blah blah :".$set{'IRCNAME'}); + &sl("NICK $nick"); + @channels=(); $talkchannel=''; %mode=(); $umode=''; %limit=(); + %haveops=(); %chankey=(); +} + +sub gl { + if ($buffer{$_[0]} =~ /^([^\n\r]*)\r?\n\r?/) { + $buffer{$_[0]}=$'; + $_=$1."\n"; + return 1; + } + local($buf)=''; + # &tell("About to sysread: $_[0]"); + if (sysread($_[0], $buf, 4096)) { + $buffer{$_[0]}.=$buf; + if ($buffer{$_[0]} =~ /^([^\n\r]*)\r?\n\r?/) { + $buffer{$_[0]}=$'; + $_=$1."\n"; + return 1; + } + return ''; + } + $_=''; + return 1; +} + +sub sl { + $logging && print LOG "<<".$_[0]."\n"; + if(!print $S $_[0]."\n"){ + &print("*\cbE\cb* Error writing to server: $!"); + &tell("*\cbE\cb* Connection to server lost"); + close($S); + delete $buffer{$S}; + $connected=0; + &dohooks("disconnect"); + &bindtoserver; + } + elsif (time-$floodtimer < 1){ + select(undef, undef, undef, 0.5); + } + $floodtimer=time; +} + +sub dostatus { + return unless $ssfe; + local($t, $s)=($talkchannel, " [sirc] "); + my($i); + for($i=0; $i<=$#channels; $i++){ + $s = " [sirc] "; + $t = $channels[$i]; + $t =~ tr/A-Z/a-z/; + $s.="*" if $umode =~ /o/; + $s.="\@" if $t && $haveops{$t}; + $s.=$nick; + $s.=" (+$umode)" if $umode; + $s.=" [query: ${query}]" if $query; + $s.=" (away)" if $away; + if ($talkchannel ne '') { + $s.=" on $t (+$mode{$t})"; + $s.=" <key: $chankey{$t}>" if $chankey{$t}; + $s.=" <limit: $limit{$t}>" if $limit{$t}; + } + &dohooks("status", $s); +# $laststatus=$s, print "~${t}~`#ssfe#s$s\n" if $laststatus ne $s; + $laststatus=$s; + $logging && print LOG "** ~${t}~`#ssfe#s$s\n"; + print "~${t}~`#ssfe#s$s\n"; + } +} + +$bold="\c[[1m"; +$underline="\c[[4m"; +$reverse="\c[[7m"; +$normal="\c[[m"; +$cls="\c[[H\c[[2J"; + +sub enhance { + local($what)=@_; + $what =~ tr/\c@-\c^/@-^/; + return "\cv${what}\cv"; +} + +sub print { + local($skip, $what)=(0, @_); + &dohooks("print", $what); + return if $skip; + $what =~ s/\s+$//; + # thanks to Toy (wacren@obspm.fr) for this translation + $what =~ tr/\x80-\xff/\x00-\x1f !cLxY|$_ca<\-\-R_o+23\'mp.,1o>123?AAAAAAACEEEEIIIIDNOOOOO*0UUUUYPBaaaaaaaceeeeiiiidnooooo:0uuuuypy/ + if $set{"EIGHT_BIT"} ne 'on'; + $logging && print LOG "-> " . $what."\n"; + if ($raw_mode) { + print $what, "\n" || &exit; + } elsif ($ansi) { + # this is buggy if you combine effects + $what =~ s/([\ca\cc-\ch\cj-\cu\cw-\c^])/&enhance($1)/eg; + while ($what =~ /\cb/) { + ($what =~ s/\cb([^\cb]*)\cb/$bold$1$normal/) || + $what =~ s/\cb/$bold/g; + } + while ($what =~ /\c_/) { + ($what =~ s/\c_([^\c_]*)\c_/$underline$1$normal/) || + $what =~ s/\c_/$underline/g; + } + while ($what =~ /\cv/) { + ($what =~ s/\cv([^\cv]*)\cv/$reverse$1$normal/) || + $what =~ s/\cv/$reverse/g; + } + print $what, $normal, "\n" || &exit; + } else { + $what =~ tr/\ca-\ch\cj-\c_//d; + print $what, "\n" || &exit; + } +} + +sub tell { + $silent || &print; +} + +sub dohooks { + $hooktype=shift; + local(@hl); + eval "\@hl=\@${hooktype}_hooks;"; + foreach $h (@hl) { + eval { &$h(@_); }; + $@ =~ s/\n$//, &tell("*\cbE\cb* error in $hooktype hook &$h: $@") + if $@ ne ''; + } +} + +sub dcerror { + local($fh, $n)=($_[0], $dcnick{$_[0]}); + &dohooks("chat_disconnect", $n); + &tell("*\cbE\cb* DCC chat with $n lost"); + &tell("~!dcc~Closing DCC CHAT with who: $n"); + close($fh); + $n =~ tr/A-Z/a-z/; + delete $dcnick{$fh}; + delete $dcvol{$n}; + delete $dcfh{$n}; + delete $buffer{$fh}; +} + +sub dgsclose { + local($sfh, $rfh, $type, $err)=@_; + &dohooks("dcc_disconnect", $dnick{$sfh}, $dfile{$rfh}, $dtransferred{$sfh}, + time-$dstarttime{$rfh}, $rfh); + &tell("*\cbD\cb* DCC $type with $dnick{$sfh} ($dfile{$rfh}) terminated; $dtransferred{$sfh} bytes transferred in ".(time-$dstarttime{$rfh}). " seconds"); + &tell("~!dcc~DCC $type terminated who: $dnick{$sfh} file: $dfile{$rfh} reason: $err"); + close($sfh); + close($rfh); + delete $dgrfh{$sfh}; + delete $dsrfh{$sfh}; + delete $dfile{$rfh}; + delete $dstarttime{$rfh}; + delete $dtransferred{$sfh}; + delete $dsoffset{$sfh}; + delete $dsport{$sfh}; + delete $dsresumedb{$sfh}; + delete $dgxferadd{$sfh}; + delete $dnick{$sfh}; +} + +sub msg { + local($towho, $what)=@_; + print "`#ssfe#t/m $towho \n" if $ssfe && !&eq($towho, $talkchannel); + if ($towho =~ s/^=//) { + local($n, $fh)=($towho); + $n =~ tr/A-Z/a-z/; + $fh=$dcfh{$n}; + if ($fh) { + (print $fh $what."\n") || &dcerror($fh); + $dcvol{$n}+=length($what); + &dohooks("send_dcc_chat", $towho, $what); + &tell("~=${towho}~|\cb$towho\cb| $what"); #KSIRC MOD + } else { + &tell("*\cbE\cb* No active DCC chat with $towho"); + } + } elsif ($connected>1) { + $what=substr($what, 0, 485); + &dohooks("send_text", $towho, $what); + if (&eq($towho, $talkchannel) && !$printchan) { + &tell("~${towho}~<${nick}> $what"); # KSIRC MOD + } elsif ($towho =~ /^[\&\#\+]/) { + &tell("~${towho}~<$nick> $what"); #KSIRC MOD + } else { + &tell("~${towho}~>${nick}< $what"); #KSIRC MOD + } + &sl("PRIVMSG $towho :$what"); + } else { + &tell("*** You're not connected to a server"); + } +} + +sub say { + if ($query) + { + &msg($query, @_); + } + elsif ($talkchannel) { + &msg($talkchannel, @_); + } else { + &tell("*\cbE\cb* Not on a channel"); + } +} + +sub notice { + local($towho, $what)=@_; + $what=substr($what, 0, 485); + &dohooks("send_notice", $towho, $what); + &tell("~${towho}~-> -~n${towho}~n- $what"); + &sl("NOTICE $towho :$what"); +} + +sub describe { + local($towho, $what)=@_; + $what=substr($what, 0, 480); + &dohooks("send_action", $towho, $what); + if (&eq($towho, $talkchannel) && !$printchan) { + &tell("~${towho}~* $nick $what"); # KSIRC MOD + } elsif ($towho =~ /^[\#\&\+]/) { + &tell("~${towho}~* $nick $what"); # KSIRC MOD + } else { + &tell("~${towho}~* $nick $what"); #KSIRC MOD +# &tell("~${towho}~*-> \cb${towho}\cb: $nick $what"); #KSIRC MOD + } + &sl("PRIVMSG $towho :\caACTION".($what eq "" ? "" : " ").$what."\ca"); +} + +sub me { + if ($talkchannel) { + &describe($talkchannel, @_); + } else { + &tell("*\cbE\cb* Not on a channel"); + } +} + +sub yetonearg { + ($newarg, $args)=split(/ +/, $args, 2); + $args =~ s/^://; +} + +sub getarg { + ($newarg, $args)=split(/ +/, $args, 2); +} + +@weekdays=("Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"); +@months=("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", + "Nov", "Dec"); + +sub date { + local($sec, $min, $hour, $mday, $mon, $year, $wday)=localtime($_[0]); + return sprintf("$weekdays[$wday] $months[$mon] $mday %.2d:%.2d:%.2d %d", + $hour, $min, $sec, $year+1900); +} + +sub reply { + return if $set{"CTCP"} eq 'noreply'; + if ($lastrep<time-10) { + $lastrep=time; + $nreps=1; + } else { + return if $nreps++>=2 && $set{"CTCP"} eq 'noflood'; + } + &sl("NOTICE $who :\ca$_[0]\ca"); +} + +sub ctcp { + local($towho, $to, $what)=$_[0]; + ($what, $args)=split(/ +/, $_[1], 2); + $what =~ tr/a-z/A-Z/; + &dohooks("ctcp", $towho, $what, $args); + return if $skip; + local($a)=$args; + $a && ($a=' '.$a); + $to = (&eq($towho, $nick) ? "you" : $towho); + + &tell("~$to~*** $who$puh1 did a CTCP $what$a to $to") + unless $what =~ /^(ACTION|PING|DCC|VERSION)$/; + if ($what eq 'ACTION') { + &dohooks("action", $towho, $args); + if (&eq($towho, $nick)) { + &tell("~$who~* \cb${who}\cb$puh1 $args"); # KSIRC MOD + } elsif (&eq($towho, $talkchannel) && !$printchan) { + &tell("~$towho~* $who $args"); #KSIRC MOD + } else { + &tell("~$towho~* $who$puh2 $args"); #KSIRC MOD + } + } elsif ($what eq 'TIME') { + &reply("TIME ".&date(time)); + } elsif ($what eq 'CLIENTINFO') { + &reply("CLIENTINFO ACTION, CLIENTINFO, DCC, ECHO, ERRMSG, FINGER, PING, TIME, USERINFO, VERSION"); + } elsif ($what eq 'FINGER') { + &reply("FINGER ".$set{"FINGER"}); + } elsif ($what eq 'USERINFO') { + &reply("USERINFO ".$set{"USERINFO"}); + } elsif ($what eq 'VERSION') { + local($u)=$add_ons; + $u =~ s/^\+//; + $u =~ s/\+/ + /g; + $u=" -- using $u" if $u; + if($to eq 'you'){ + &tell("~$who~*** $who$puh1 did a CTCP $what$a to $to") + } + else { + &tell("~$to~*** $who$puh1 did a CTCP $what$a to $to") + } + &reply("VERSION sirc $version, a \cbperl\cb client$u"); + } elsif ($what eq 'PING') { + &reply("PING $args"); + &tell("*** $who$puh1 did a CTCP PING to $to"); #KSIRC + } elsif ($what eq 'ECHO' || $what eq 'ERRMSG') { + &reply("$what $args"); + } elsif ($what eq 'DCC') { + &getarg; + if ($newarg eq 'CHAT' || $newarg eq 'SEND' && !$restrict) { + local($dfile, $dhost, $dport, $dsize)=split(/ +/, $args, 4); + $dfile=$1 if $dfile =~ m|/([^/]*)$|; + $dfile =~ s/^\./_/; + if ($dhost==2130706433 || !$dport>1024 || $dhost !~ /^\d+$/ || + $dport !~ /^\d+$/) { + &tell("*\cbE\cb* DCC $newarg ($dfile) from $who$puh1 rejected"); + } elsif ($newarg eq 'CHAT' && grep (&eq($who, $dcwait{$_}), + keys(%dcwait))) { + &tell("*\cbD\cb* DCC chat already requested from $who, connecting..."); + my ($wfh)=(grep(&eq($dcwait{$_}, $who), keys(%dcwait))); + my ($n, $fh)=$who; + delete $dcwait{$wfh}; + close($wfh); + my $w = $who; + my $cb = sub { + my ($lfh, $lres) = @_; + if($lres != 0){ + &tell("*\cbD\cb* DCC CHAT with $w failed: " . strerror($lres)); + &tell("~!dcc~DCC CHAT failed who: $who reason: " . strerror($lres)); + close($lfh); + return; + } + $dcnick{$lfh}=$w; + &tell("*\cbD\cb* DCC CHAT with $w established"); + &tell("~!dcc~DCC CHAT established who: $w"); + $n =~ tr/A-Z/a-z/; + $dcvol{$n}=0; + $dcfh{$n}=$lfh; + print "`#ssfe#t/m =$w \n" if $ssfe; + }; + if(&connectnb($fh, $dhost, $dport, $cb) < 1) { + return; + } + } elsif ($newarg eq 'CHAT' && grep(&eq($who, $_), keys(%dcfh))) { + &tell("*\cbD\cb* DCC chat from $who$puh1 ignored (already established)"); + } else { + #&tell("*\cbD\cb* DCC $newarg ($dfile) from $who$puh1 ". + # ($dsize ? "(size: $dsize) " : "")."[$dhost, $dport]"); + my $ip = inet_ntoa(pack("N", $dhost)); + if ($newarg eq 'CHAT') { + &tell("~!dcc~DCC CHAT OFFERED who: $who$puh1 ip: $ip port: $dport"); + $dcoffered{$who}="$dhost $dport"; + &dohooks("dcc_request", "CHAT", $dhost, $dport); + } else { + my $index = 1; # KSIRC MOD - Make the file name unique + UNIQ: { + foreach $i (keys(%dgoffered)) { + my($h, $p, $f) = split(/ /, $i); + if (&eq($f, $dfile)) { + $dfile =~ s/(.*)\.\d+$/$1/; + $dfile .= ".$index"; + $index++; + redo UNIQ; + } + } + } + &tell("~!dcc~INBOUND DCC SEND who: $who$puh1 file: $dfile size: $dsize ip: $ip port: $dport"); + + $dgoffered{"$dhost $dport $dfile"}=$who; + &dohooks("dcc_request", "SEND", $dhost, $dport, $dfile, $dsize); + } + } + } else { + &tell("*** $who$puh1 did a CTCP ${what}$a to $to"); + } + } +} + +sub doset { + local($var, $val)=@_; + $var =~ tr/a-z/A-Z/; + $val="" unless defined($val); + if ($var eq 'PRINTUH') { + $set{$var}="all" if $val =~ /^(on|all)$/i; + $set{$var}="some" if $val =~ /^some$/i; + $set{$var}="none" if $val =~ /^(off|none)$/i; + } elsif ($var eq 'PRINTCHAN') { + $set{$var}="on", $printchan=1 if $val =~ /^on$/i; + $set{$var}="off", $printchan=0 if $val =~ /^off$/i; + } elsif ($var eq 'CTCP') { + $val =~ tr/A-Z/a-z/; + $set{$var}=$val if $val =~ /^(none|all)$/; + $set{$var}="noreply" if $val =~ /^(noreply|off)$/; + $set{$var}="noflood" if $val =~ /^(noflood|on)$/; + } elsif ($var eq 'SENDAHEAD') { + $set{$var}=$val if $val =~ /^\d+$/ && $val<=65536; + } elsif ($var eq 'USERINFO') { + $set{$var}=$val; + } elsif ($var eq 'FINGER') { + $set{$var}=$val; + } elsif ($var eq 'IRCNAME') { + $set{$var}=$val; + } elsif ($var eq 'EIGHT_BIT') { + $val =~ tr/A-Z/a-z/; + $set{$var}=$val if $val =~ /^(on|off)$/; + } elsif ($var eq 'LOCALHOST') { + &restrict || return; + # IPV6: DCC is always ipv4 :( + local($ad) = (&resolve($val, 0, &AF_INET))[3]; + $set{$var}=$val, $bindaddr=$ad if $ad; + } elsif ($var eq 'LOADPATH') { + @loadpath=split(/:/, $val); + foreach (@loadpath) { + &tilde($_); + } + $set{$var}=join(":", @loadpath); + } elsif ($var eq 'CTRL_T') { + $set{$var}=$val; + print "`#ssfe#T$val\n" if $ssfe; + } elsif ($var eq 'LOGFILE') { + &restrict || return; + &tilde($val); + $logfile=$set{$var}=$val; + } elsif ($var eq 'LOG') { + &restrict || return; + if ($val =~ /^on$/i) { + $logging && close LOG; + if (open(LOG, + ($logfile =~ /\.gz$/ ? "| gzip >> $logfile" : ">> $logfile"))) { + $logging=1; + $set{$var}="on"; + select(LOG); $|=1; select(STDOUT); + print LOG "*\cbL\cb* IRC log started on ".&date(time)."\n"; + } else { + $logging=''; + $set{$var}="off"; + &tell("*\cbE\cb* Can't write to logfile $logfile"); + } + } elsif ($val =~ /^off$/i) { + print LOG "*\cbL\cb* Log ended on ".&date(time)."\n", close LOG + if $logging; + $logging=''; + $set{$var}="off"; + } + } elsif (defined($sets{$var})) { + local($f)=$sets{$var}; + eval { &$f($val); }; + $@ =~ s/\n$//, &tell("*\cbE\cb* error in SET $var hook: $@") if $@ ne ''; + } +} + +sub ctcpreply { + local($ctcp, $rest)=split(/ +/, $_[1], 2); + $ctcp =~ tr/a-z/A-Z/; + &dohooks("ctcp_reply", $_[0], $ctcp, $rest); + $rest=(time-$rest)." seconds" if $ctcp eq 'PING'; + if (&eq($_[0], $nick)) { + &tell("*** CTCP $ctcp reply from $who$puh1: $rest"); + } else { + &tell("*** CTCP $ctcp reply to $_[0] from $who$puh2: $rest"); + } +} + +sub load { + local($f)=@_; + &tilde($f); + if ($f !~ /\//) { + foreach (@loadpath) { + $f="$_/$f", last if -f "$_/$f"; + $f="$_/${f}.pl", last if $f !~ /\.pl$/ && -f "$_/${f}.pl"; + } + } else { + $f.=".pl" if -f "${f}.pl" && !-f $f; + } + if ($f =~ /\// && -f $f) { + do $f; + $@ =~ s/\n$//, &tell("*\cbE\cb* Load error in $f: $@") if $@ ne ''; + } else { + &tell("*\cbE\cb* $f: File not found"); + } +} + +sub restrict { + &tell("*\cbE\cb* Command not available"), return 0 if $restrict; + 1; +} + +sub dosplat { + $args =~ s/^\s*\*($|\s)/${talkchannel}${1}/ if $talkchannel; +} + +sub expand { + if ($_[0] eq '$') { + return '$'; + } elsif ($_[0] =~ /^(\d+)$/) { + return (split(/ +/, $args))[$1]; + } elsif ($_[0] =~ /^(\d+)-$/) { + return (split(/ +/, $args, 1+$1))[$1]; + } else { + return eval "\$$_[0]"; + } +} + +$recdepth=0; +$maxrecursion=20; + +sub docommand { + local($line)=@_; + local($recdepth)=$recdepth+1; + &print("*\cbE\cb* Max recursion exceeded!"), return + if $recdepth > $maxrecursion; + local($noalias)=($line =~ s/^\///); + local($silent)=1 if $line =~ s/^\^//; + local($cmd, $args)=split(/ +/, $line, 2); + $cmd =~ tr/a-z/A-Z/; + if (!$noalias && defined($aliases{$cmd})) { + $line=$aliases{$cmd}; + $line.=($args ne '' ? " ".$args : "") + unless ($line =~ s/\$(\$|\d+-?|\w+)/&expand($1)/eg); + $line =~ s/^\///; + $noalias=1 if $line =~ s/^\///; + $silent=1 if $line =~ s/^\^//; + ($cmd, $args)=split(/ +/, $line, 2); + $cmd =~ tr/a-z/A-Z/; + } + if (!$noalias && defined($cmds{$cmd})) { + eval $cmds{$cmd}; + $@ =~ s/\n$//, &tell("*\cbE\cb* error in command $cmd: $@") if $@ ne ''; + } elsif ($cmd eq 'ALIAS') { + &getarg; + if ($newarg =~ /^-/) { + local($a)=$'; + if ($a eq '') { + %aliases=(); + &tell("*** All aliases removed"); + } else { + $a =~ tr/a-z/A-Z/; + delete $aliases{$a}; + &tell("*** Alias $a removed"); + } + } elsif ($newarg ne '') { + $newarg =~ tr/a-z/A-Z/; + if ($args ne '') { + $aliases{$newarg}=$args; + &tell("*** $newarg aliased to $args"); + } else { + if (defined($aliases{$newarg})) { + &tell("*** $newarg is aliased to: $aliases{$newarg}"); + } else { + &tell("*** $newarg: no such alias"); + } + } + } else { + foreach $a (sort(keys(%aliases))) { + &tell("*** $a is aliased to $aliases{$a}"); + } + } + } elsif ($cmd eq 'SET') { + &getarg; + local($s)=$newarg; + $s =~ tr/a-z/A-Z/; + if ($s =~ s/^-//) { + &tell("*** No such variable $s"), return unless defined($set{$s}); + &doset($s, ""); + &tell("*** $s is ".($set{$s} ne '' ? "set to $set{$s}" : "unset")); + } elsif ($s ne '') { + &tell("*** No such variable $s"), return unless defined($set{$s}); + &doset($s, $args) if $args ne ''; + &tell("*** $s is ".($set{$s} ne '' ? "set to $set{$s}" : "unset")); + } else { + foreach $s (sort(keys (%set))) { + &tell("*** $s is ".($set{$s} ne '' ? "set to $set{$s}" : "unset")); + } + } + } elsif ($cmd eq 'NOTIFY' || $cmd eq 'N') { + if ($args eq '-') { + &tell("*** Notify list cleared"); + my($value); + while(($_, $value) = each %notify){ # Remove all nicks + &tell("*\cb(\cb* Signoff by $_ detected!"); # KSIRC MOD + } + %notify=(); + } elsif ($args eq '') { + local($l)=''; + foreach (grep($notify{$_}, keys %notify)) { + &tell("*** Currently present: $l"), $l='' if length($l)>450; + &tell("*\cb)\cb* Signon by $_ detected!"); # KSIRC MOD + $l.=$_." "; + } + $l && &tell("*** Currently present: $l"); + $l=''; + foreach (grep(!$notify{$_}, keys %notify)) { + &tell("*** Currently absent: $l"), $l='' if length($l)>450; + &tell("*\cb(\cb* Signoff by $_ detected!"); # KSIRC MOD + $l.=$_." "; + } + $l && &tell("*** Currently absent: $l"); + } else { + local($w, $n); + foreach $w (split(/ +/, $args)) { + if ($w =~ s/^-//) { + ($n)=(grep(&eq($_, $w), keys(%notify)), ''); + $n ne '' && delete $notify{$n}; + &tell("*** $w removed from notify list"); + &tell("*\cb(\cb* Signoff by $w detected!"); # KSIRC MOD + } else { + $notify{$w}='0'; + &tell("*** $w added to notify list"); + $newisons=1; + } + } + } + } elsif ($cmd eq 'IGNORE' || $cmd eq 'IG') { + &getarg; + if ($newarg eq '-') { + @ignore=(); + &tell("*** Ignore list cleared"); + } elsif ($newarg eq '') { + local($p); + &tell("*** You're ignoring:"); + foreach (@ignore) { + $p=$_; + $p =~ s/\\//g; + $p =~ s/\.\*/*/g; + &tell("*** $p"); + } + } else { + local($d, $p)=(''); + $d=1 if $newarg =~ s/^-//; + if ($newarg =~ /\!.*\@/) { + } elsif ($newarg !~ /[\@\!]/) { + $newarg.="!*"; + } elsif ($newarg =~ /\@/) { + $newarg="*!".$newarg; + } else { + $newarg.="\@*"; + } + $p=$newarg; + $newarg =~ s/([^\\])\./$1\\./g; + $newarg =~ s/\*/\.\*/g; + $newarg =~ s/([^\.\*\\\w])/\\$1/g; + if ($d) { + &tell("*** Removing $p from the ignore list"); + @ignore=grep(!&eq($_, $newarg), @ignore); + } else { + &tell("*** Ignoring $p ... what a relief!"); + push(@ignore, $newarg); + } + } + } elsif ($cmd eq 'ECHO') { + &print($args); + } elsif ($cmd eq 'CLEAR' || $cmd eq 'CL') { + print $cls if $ansi; + print "`#ssfe#l\n" if $ssfe; + } elsif ($cmd eq 'EVAL') { + &restrict || return; + eval ($args); + $@ =~ s/\n$//, &tell("*\cbE\cb* eval error: $@") if $@ ne ''; + } elsif ($cmd eq 'HELP') { + &tell("*\cbH\cb* Help not available"), return unless @help; + $args='main' if $args =~ /^\s*$/; + $args =~ s/ *$//; + local($found)=''; + foreach (@help) { + if (/^\@/) { + last if $found; + if (&eq($_, "\@$args")) { + $found=1; + &tell("*\cbH\cb* Help on $args") if $args ne 'main'; + } + } else { + &tell("*\cbH\cb* $_") if $found; + } + } + &tell("*\cbH\cb* Unknown help topic; try /help") unless $found; + } elsif ($cmd eq 'LOAD') { + &restrict || return; + &getarg; + &tell("*\cbE\cb* Yeah, but what?"), return if $newarg eq ''; + &load($newarg); + } elsif ($cmd eq 'VERSION') { + &tell("*** \cbsirc\cb version $version, written in \cbperl\cb by \cborabidoo\cb"); + $_=$add_ons; + s/^\+//; + s/\+/, /g; + &tell("*** add-ons: $_") if $_; + $connected==2 && &sl("VERSION $args"); + } elsif ($cmd eq 'CD') { + &restrict || return; + &getarg; + if ($newarg ne '') { + &tilde($newarg); + chdir($newarg) || &tell("*\cbE\cb* Can't chdir to $newarg"); + } + local($cwd); chop($cwd=`pwd`); + &tell("*** Current directory is $cwd"); + } elsif ($cmd eq 'SYSTEM') { + &restrict || return; + system($args); + } elsif ($cmd eq 'BYE' || $cmd eq 'QUIT' || $cmd eq 'EXIT' || + $cmd eq 'SIGNOFF') { + $args || ($args="using sirc version $version$add_ons"); + &dohooks("quit"); + &sl("QUIT :$args") if $connected; + &exit; + } elsif ($cmd eq 'SERVER') { + $args=$1 if $args =~ /^\s*(.*)\s*$/; + $args="$server0:$port0:$pass0" if $args eq '0'; + $args="$server1:$port1:$pass1" if $args eq '1'; + if ($args eq '') { + &tell($connected ? "*** Your current server is $server" : + "*** You're not connected to a server"); + } else { + ($server, $port, $pass)=split(/[\s:]+/, $args); + $server=$', $nick=$1 if $server =~ /^([^\@]+)\@/; + $port || ($port=$port0); + &sl("QUIT :changing servers"), close $S, delete $buffer{$S} if $connected; + $connected=0; + } + } elsif ($cmd eq 'MSG' || $cmd eq 'M') { + &dosplat; + if ($args) { + ($newarg, $args)=split(/ /, $args, 2); + &msg($newarg, $args); + } else { + &tell("*\cbE\cb* You must specify a nick or channel!"); + } + } elsif ($cmd eq 'QUERY' || $cmd eq 'Q') { + if ($args) { + $args =~ s/\s+$//; + $query=$args; + &tell("*** Starting conversation with $query"); + &dostatus; + } elsif ($query) { + &tell("*** Ending conversation with $query"); + $query=''; + &dostatus; + } else { + &tell("*** You aren't querying anyone :p"); + } + } elsif ($cmd eq 'DCC') { + &getarg; + if ($newarg =~ /^chat$/i) { + &getarg; + local($n)=grep(&eq($newarg, $_), keys(%dcoffered)); + if ($n) { + local($dcadr, $dcport)=split(/ +/, $dcoffered{$n}); + local($fh); + delete $dcoffered{$n}; + my $w = $n; + my $cb = sub { + my ($lfh, $lres) = @_; + if($lres != 0){ + &tell("*\cbD\cb* DCC CHAT with $w failed: " . strerror($lres)); + &tell("~!dcc~DCC CHAT failed who: $w reason: " . strerror($lres)); + close($lfh); + return; + } + $dcnick{$lfh}=$w; + &tell("*\cbD\cb* DCC CHAT with $w established"); + &tell("~!dcc~DCC CHAT established who: $w"); + print "`#ssfe#t/m =$w \n" if $ssfe; + my $n = $w; + $n =~ tr/A-Z/a-z/; + $dcvol{$n}=0; + $dcfh{$n}=$fh; + }; + if(&connectnb($fh, $dcadr, $dcport, $cb) < 1){ + return; + } + } elsif (grep (&eq($newarg, $dcwait{$_}), keys(%dcwait))) { + &tell("*\cbE\cb* DCC CHAT request to $newarg already sent"); + } elsif (grep(&eq($newarg, $dcnick{$_}), keys(%dcnick))) { + &tell("*\cbE\cb* DCC CHAT with $newarg already established"); + } elsif ($newarg) { + &tell("*** You're not connected to a server"), return if $connected<2; + &tell("*** Don't be antisocial!"), return if &eq($newarg, $nick); + local($mynumber, $myport, $fh); + my $sockaddr = &listen($fh) or return; + if ($ipv6) { + # XXX: substr is used in order to avoid dying on Linux with older + # glibc that lacks the scope field from sockaddr_in6 but the kernel + # has it and returns it from getsockname() + ($myport, undef) = unpack_sockaddr_in6(substr($sockaddr, 0, 24)); + $mynumber = '0'; + } else { + ($myport, $mynumber) = unpack_sockaddr_in(&listen($fh)) or return; + $mynumber = unpack("N", $mynumber); + } + $dcwait{$fh}=$newarg; + &sl("PRIVMSG $newarg :\caDCC CHAT chat $mynumber $myport\ca"); + &dohooks("send_ctcp", $newarg, "DCC CHAT chat $mynumber $myport"); + &tell("*\cbD\cb* Sent DCC CHAT request to $newarg"); + &tell("~!dcc~DCC CHAT SEND who: $newarg"); + } else { + &tell("*** I need a nick"); + } + } elsif ($newarg =~ /^rchat$/i) { + &getarg; + local($n)=$newarg; + &getarg; + if ($newarg) { + local($fh)=grep(&eq($dcnick{$_}, $n), keys(%dcnick)); + if( ! $fh){ + &tell("*\cbE\cb* No DCC CHAT established with $n"); + &tell("~!dcc~No DCC CHAT established who: $n"); + return; + } + &tell("*\cbE\cb* DCC CHAT already established with $newarg"), return + if grep(&eq($dcnick{$_}, $newarg), keys(%dcnick)); + &tell("*\cbD\cb* DCC CHAT with $n renamed to $newarg"); + &tell("~!dcc~DCC CHAT renamed who: $n to: $newarg"); + $dcnick{$fh}=$newarg; + $n =~ tr/A-Z/a-z/; + $newarg =~ tr/A-Z/a-z/; + $dcfh{$newarg}=$dcfh{$n}; + $dcvol{$newarg}=$dcvol{$n}; + delete $dcfh{$n}; + delete $dcvol{$n}; + } else { + &tell("*** I need *two* nicks"); + } + } elsif ($newarg =~ /^close$/i) { + &getarg; + if ($newarg =~ /^chat$/i) { + &getarg; + local($n)=$newarg; + $newarg =~ tr/A-Z/a-z/; + local($fh)=$dcfh{$newarg}; + local($nn)=(grep(&eq($_, $newarg), keys(%dcoffered))); + if ($nn) { + &tell("*\cbD\cb* Forgetting offered DCC CHAT from $nn"); + &tell("~!dcc~Closing DCC CHAT who: $nn"); + delete $dcoffered{$nn}; + if($no_reject == 0){ + $who = $nn; + &reply("DCC REJECT CHAT chat"); + } + $no_reject = 0; + } elsif ($fh) { + &dohooks("chat_disconnect", $n); + &tell("*\cbD\cb* Closing DCC CHAT connection with $n"); + &tell("~!dcc~Closing DCC CHAT who: $n"); + close($fh); + delete $dcnick{$fh}; + delete $dcvol{$newarg}; + delete $dcfh{$newarg}; + delete $buffer{$fh}; + if($no_reject == 0){ + $who = $n; + &reply("DCC REJECT CHAT chat"); + } + $no_reject = 0; + + } elsif (($fh)=grep(&eq($dcwait{$_}, $n), keys (%dcwait)), $fh) { + close($fh); + delete $dcwait{$fh}; + &tell("*\cbD\cb* Closing listening DCC CHAT with $n"); + &tell("~!dcc~Closing DCC CHAT who: $n"); + if($no_reject == 0){ + $who = $n; + &reply("DCC REJECT CHAT chat"); + } + $no_reject = 0; + } else { + if($n){ + &tell("*\cbE\cb* No DCC CHAT connection with $n"); + &tell("~!dcc~No DCC CHAT connection who: $n"); + } + } + } elsif ($newarg =~ /^get$/i) { + &getarg; + my $arg = $newarg; + local($found)=''; + foreach $i (keys(%dgoffered)) { + if (&eq($dgoffered{$i}, $newarg) && (!$args || + &eq($args, (split(/ +/, $i))[2]))) { + &tell("*\cbE\cb* Forgetting pending DCC GET from $newarg"); + my($host, $port, $file) = split(/ /, $i); + &tell("~!dcc~Closing DCC GET connection with who: $newarg file: $file"); # KSIRC MOD + delete $dgoffered{$i}; + $found=1; + if($no_reject == 0){ + $who = $newarg; + &reply("DCC REJECT GET $file"); + } + $no_reject = 0; + } + } + foreach $sfh (grep(&eq($newarg, $dnick{$_}), keys(%dnick))) { + if (!$found && $dgrfh{$sfh}) { + local($fh)=$dgrfh{$sfh}; + my($file)=$dfile{$fh}; + next if $args && ($args ne $dfile{$fh}); + &dohooks("dcc_disconnect", $dnick{$sfh}, $dfile{$fh}, + $dtransferred{$sfh}, time-$dstarttime{$fh}, $fh); + + &tell("*\cbE\cb* Closing DCC GET connection with: $newarg ($file)"); # KSIRC MOD + &tell("~!dcc~Closing DCC GET connection with who: $newarg file: $file"); # KSIRC MOD + $found=1; + close $sfh; + close $fh; + delete $dgrfh{$sfh}; + delete $dfile{$fh}; + delete $dstarttime{$fh}; + delete $dtransferred{$sfh}; + delete $dgxferadd{$sfh}; + delete $dnick{$sfh}; + if($no_reject == 0){ + $who = $newarg; + &reply("DCC REJECT GET $file"); + } + $no_reject = 0; + } + } + if( ! $found){ + &tell("*\cbE\cb* No DCC GET connection with $newarg for $arg"); + &tell("~!dcc~No DCC GET connection who: $newarg file: $arg"); + } + } elsif ($newarg =~ /^send$/i) { + &getarg; + local($n, $found, $fh)=($newarg, ''); + &getarg; + my $arg = $newarg; + $newarg =~ s/(\W)/\\$1/g; + foreach $sfh (keys(%dswait), keys(%dsrfh)) { + next unless &eq($dnick{$sfh}, $n); + $fh=$dswait{$sfh} || $dsrfh{$sfh} || next; + if ($newarg eq '' || $dfile{$fh} =~ /^${newarg}$/ || + $dfile{$fh} =~ /\/${newarg}$/) { + #&tell("*\cbD\cb* DCC SEND connection with $n closed"); + #my($file)=$dfile{$fh}; + #&tell("~!dcc~Closing DCC SEND connection with who: $n file: $file"); # KSIRC MOD + #&dohooks("dcc_disconnect", $dnick{$sfh}, $dfile{$fh}, + # $dtransferred{$sfh}, time-$dstarttime{$fh}, $fh); + #close($sfh); + #close($fh); + #delete $dswait{$sfh}; + #delete $dsrfh{$sfh}; + #delete $dfile{$fh}; + #delete $dstarttime{$fh}; + #delete $dtransferred{$sfh}; + #delete $dsoffset{$sfh}; + #delete $dsport{$sfh}; + #delete $dsresumedb{$sfh}; + #delete $dgxferadd{$sfh}; + #delete $dnick{$sfh}; + if($no_reject == 0){ + $who = $n; + &reply("DCC REJECT SEND $dfile{$fh}"); + } + $no_reject = 0; + + if($dstarttime{$fh} == undef) { + $dstarttime{$fh} = time; + } + &dgsclose($sfh, $fh, "SEND", "CLOSE"); + + $found=1; + } + } + if(!$found){ + &tell("*\cbE\cb* No DCC SEND connection with $n for $arg"); + &tell("~!dcc~No DCC SEND connection with who: $n file: $arg"); + } + } else { + &tell("*\cbE\cb* Unknown DCC type"); + } + } elsif ($newarg =~ /^rename$/i) { + local($found, $n); + &getarg; + $n=$newarg; + &getarg; + $args=$newarg, $newarg='' if $args eq ''; + &tell("*\cbE\cb* I need a filename :p"), return if $args eq ''; + &tilde($args); + foreach $i (keys(%dgoffered)) { + if (&eq($dgoffered{$i}, $n) && (!$newarg || + &eq($newarg, (split(/ +/, $i))[2]))) { + local($m, $p, $f)=split(/ +/, $i); + delete $dgoffered{$i}; + $dgoffered{"$m $p $args"}=$n; + &tell("*\cbD\cb* Renaming \"$f\" (offered by $n) to \"$args\""); + $found=1; + last; + } + } + &tell("*\cbE\cb* No such file offered by $n") unless $found; + } elsif ($newarg =~ /^get$/i) { + &getarg; + local($n)=grep((&eq($newarg, $dgoffered{$_}) && (!$args || + &eq($args, (split(/ +/, $_))[2]))), + keys(%dgoffered)); + if ($n) { + my($dgadr, $dgport, $file)=split(/ +/, $n); + my($fh, $sfh); + my $offset = 0; + $n=(delete $dgoffered{$n}); + $fh=&newfh; + if($dgresume{$dgport} && $dgresume{$dgport}{"GotReply"}){ + &print("*\cbE\cb* Can't write to file $file"), return unless open($fh, ">> $file"); + seek($fh, $dgresume{$dgport}{"pos"}, SEEK_SET); + $offset = $dgresume{$dgport}{"pos"}; + delete $dgresume{$dgport}; + } + else { + &print("*\cbE\cb* Can't write to file $file"), return unless open($fh, "> $file"); + } + my $who = $n; + my $cb = sub { + my ($lfh, $lres) = @_; + if($lres != 0){ + &tell("*\cbD\cb* DCC GET connection with $who ($file) failed: " . strerror($lres)); + &tell("~!dcc~DCC GET failed who: $who file: $file reason: " . strerror($lres)); + close($lfh); + return; + } + $dgrfh{$lfh}=$fh; + $dnick{$lfh}=$who; + $dfile{$fh}=$file; + $dstarttime{$fh}=time; + $dtransferred{$lfh}=0; + $dgxferadd{$lfh}=$offset; + &tell("*\cbD\cb* DCC GET connection with $who established"); + &tell("~!dcc~DCC GET established who: $who file: $file"); + &dohooks("dcc_get", $who, $file, $fh); + }; + if(&connectnb($sfh, $dgadr, $dgport, $cb) < 1){ + return; + } + } else { + if ($newarg) { + &tell("*\cbE\cb* No pending DCC GET from $newarg"); + } else { + &tell("*\cbE\cb* Uhm, who from?"); + } + } + } elsif ($newarg =~ /^list$/i || $newarg eq '') { + &tell("*\cbD\cb* List of DCC connections:"); + foreach $n (keys(%dcfh)) { + &tell("*\cbD\cb* Established DCC CHAT with $n ($dcvol{$n} bytes)"); + } + foreach $n (keys(%dcoffered)) { + my ($pip, $port) = split(/ /, $dcoffered{$n}); + my $ip = inet_ntoa(pack("N", $pip)); + &tell("*\cbD\cb* DCC CHAT offered by $n ($ip:$port)"); + } + foreach $f (keys(%dcwait)) { + &tell("*\cbD\cb* DCC CHAT offered to $dcwait{$f}"); + } + foreach $i (keys(%dgoffered)) { + my ($pip, $port, $file) = split(/ /, $i); + my $ip = inet_ntoa(pack("N", $pip)); + &tell("*\cbD\cb* DCC GET \"$file\" ($ip:$port) offered by $dgoffered{$i}"); + } + foreach $s (keys(%dgrfh)) { + local($f)=$dgrfh{$s}; + &tell("*\cbD\cb* DCC GET \"$dfile{$f}\" established with $dnick{$s}, $dtransferred{$s} bytes read in ".(time-$dstarttime{$f})." seconds."); + } + foreach $s (keys(%dswait)) { + local($f)=$dswait{$s}; + &tell("*\cbD\cb* DCC SEND \"$dfile{$f}\" offered to $dnick{$s}"); + } + foreach $s (keys(%dsrfh)) { + local($f)=$dsrfh{$s}; + &tell("*\cbD\cb* DCC SEND \"$dfile{$f}\" established with $dnick{$s}, $dtransferred{$s} bytes sent in ".(time-$dstarttime{$f})." seconds."); + } + } elsif ($newarg =~ /^send$/i) { + &tell("*** You're not connected to a server"), return if $connected<2; + &restrict || return; + local(($n),($f)) = $args =~ /^(.+?) (.+)/; + local($tf, $mynumber, $sz, $fh, $myport, $lfh)=($f); + &tilde($f); + while (my($fh, $ni) = each %dnick ) { + if(&eq($n, $ni)){ + my $lfh = $dswait{$fh}; + if(&eq($dfile{$lfh}, $f)){ + &tell("*\cbE\cb* DCC Send already pending of $f to $n"); + return; + } + if($dsrfh{$fh}){ + &tell("*\cbE\cb* DCC Send already in progress $f to $n"); + return; + + } + } + } + $fh=&newfh; + &tell("*\cbE\cb* Can't open file $f"), return unless open($fh, "<$f"); + my $sockaddr = &listen($lfh) or (close $fh, return); + if ($ipv6) { + # XXX: substr is used in order to avoid dying on Linux with older + # glibc that lacks the scope field from sockaddr_in6 but the kernel + # has it and returns it from getsockname() + ($myport, undef) = unpack_sockaddr_in6(substr($sockaddr, 0, 24)); + $mynumber = 0; + } else { + ($myport, $mynumber) = unpack_sockaddr_in($sockaddr); + $mynumber = unpack("N", $mynumber); + } + $dswait{$lfh}=$fh; + $tf=$1 if $f =~ m|/([^/]*)$|; + $sz=(-s $f); + $tf =~ s/ /_/g; # we have to convert spaces in the filename to underscores + &sl("PRIVMSG $n :\caDCC SEND $tf $mynumber $myport $sz\ca"); + &dohooks("send_ctcp", $n, "DCC SEND $tf $mynumber $myport $sz"); + &dohooks("dcc_send", $n, $f, $sz, $fh); + #&tell("*\cbD\cb* Sent DCC SEND request to $n ($f,$sz)"); + &tell("~!dcc~Sent DCC SEND request to who: $n file: $f size: $sz"); + $dfile{$fh}=$f; + $dswait{$lfh}=$fh; + $dnick{$lfh}=$n; + $dsport{$lfh}=$myport; + $dsoffset{$lfh}=0; + } else { + &tell("*** I can \"only\" do DCC CHAT, RCHAT, GET, SEND, CLOSE, RENAME and LIST, *sheesh*"); + } + } elsif ($cmd eq 'QUOTE') { #KSIRC MOD + $args ne '' && &sl($args); #Allow this even if not connected to talk to proxies + } elsif ($connected<2) { + &tell("*** You're not connected to a server"); + } elsif ($cmd eq 'AWAY') { + &sl($args ? "AWAY :$args" : "AWAY"); + my $oldchannel = $talkchannel; + if ( $publicAway == 1 ) { + foreach $talkchannel (@channels) { + &me($args ? "is away: $args" : "is back"); + } + } + $talkchannel = $oldchannel; + } elsif ($cmd eq 'NEXT') { + if ($#channels>0) { + $talkchannel=shift(@channels); + push(@channels, $talkchannel); + !$ssfe && &tell("*** Talking to $talkchannel now"); + &dostatus; + } + } elsif ($cmd eq 'SAY' || $cmd eq '') { + &say($args); + } elsif ($cmd eq 'NOTICE' || $cmd eq 'NO') { + &dosplat; + if ($args) { + ($newarg, $args)=split(/ /, $args, 2); + ¬ice($newarg, $args); + } else { + &tell("*\cbE\cb* You must specify a nick or channel!"); + } + } elsif ($cmd eq 'DESCRIBE' || $cmd eq 'DE') { + &dosplat; + if ($args) { + ($newarg, $args)=split(/ /, $args, 2); + &describe($newarg, $args); + } else { + &tell("*\cbE\cb* You must specify a nick or channel!"); + } + } elsif ($cmd eq 'KICK' || $cmd eq 'K') { + &dosplat; + &getarg; + local($c)=$talkchannel; + if ($newarg =~ /^[\#\&\+]/) { + $c=$newarg; + &getarg; + } + if ($newarg) { + $args || ($args=$nick); + &sl("KICK $c $newarg :$args"); + } else { + &tell("*\cbE\cb* You must specify a nick!"); + } + } elsif ($cmd eq 'DISCONNECT' || $cmd eq 'DIS') { + &tell("*** Disconnecting from $server"); + close($S); + delete $buffer{$S}; + $connected=0; + &dohooks("disconnect"); + &bindtoserver; + + } elsif ($cmd eq 'INVITE' || $cmd eq 'INV' || $cmd eq 'I') { + local(@ns)=split(/ +/, $args); + local($l, $c)=(pop(@ns), $talkchannel); + if ($l =~ /^[\#\&\+]/) { + $c=$l; + } else { + $l && push(@ns, $l); + } + foreach (@ns) { + &sl("INVITE $_ $c"); + } + } elsif ($cmd eq 'CTCP') { + &dosplat; + if ($args) { + &getarg; + local($towho)=$newarg; + &getarg; + $newarg =~ tr/a-z/A-Z/; + $args=" ".$args if $args ne ''; + &sl("PRIVMSG $towho :\ca$newarg$args\ca"); + &dohooks("send_ctcp", $towho, $newarg.$args); + &tell("*** Sending a CTCP $newarg$args to $towho"); + } else { + &tell("*\cbE\cb* You must specify a nick or channel!"); + } + } elsif ($cmd eq 'PING' || $cmd eq 'P') { + &dosplat; + if ($args) { + &getarg; + local($t)=time; + &sl("PRIVMSG $newarg :\caPING $t\ca"); + &dohooks("send_ctcp", $newarg, "PING $t"); + &tell("*** Sending a CTCP PING to $newarg"); + } else { + &tell("*\cbE\cb* You must specify a nick or channel!"); + } + } elsif ($cmd eq 'ME') { + if ($talkchannel) { + &describe($talkchannel, $args); + } else { + &tell("*\cbE\cb* Not on a channel"); + } + } elsif ($cmd eq 'TOPIC' || $cmd eq 'T') { + &dosplat; + local($c)=$talkchannel; + if ($args =~ /^[\#\&\+]/) { + &getarg; + $c=$newarg; + } + if ($args) { + &sl("TOPIC $c :$args"); + } else { + &sl("TOPIC $c"); + } + } elsif ($cmd eq 'LEAVE' || $cmd eq 'PART' || $cmd eq 'HOP') { + &dosplat; + $args=$talkchannel if $args eq ''; + &sl("PART $args"); + } elsif ($cmd eq 'LL') { + if ($talkchannel) { + &sl("WHO $talkchannel"); + } else { + &tell("*\cbE\cb* Not on a channel"); + } + } elsif ($cmd eq 'O' || $cmd eq 'OP') { + local($c, $n, $l)=($talkchannel, 0, ''); + &getarg, $c=$newarg if ($args =~ /^[\#\&\+]/); + local(@ppl)=split(/ +/, $args); + foreach (@ppl) { + if ($n<4) { + $l .= " ".$_; + $n++; + } else { + &sl("MODE $c +oooo $l"); + $l=$_; + $n=1; + } + } + $l && &sl("MODE $c +oooo $l"); + } elsif ($cmd eq 'D' || $cmd eq 'DEOP') { + local($c, $n, $l)=($talkchannel, 0, ''); + &getarg, $c=$newarg if ($args =~ /^[\#\&\+]/); + local(@ppl)=split(/ +/, $args); + foreach (@ppl) { + if ($n<4) { + $l .= " ".$_; + $n++; + } else { + &sl("MODE $c -oooo $l"); + $l=$_; + $n=1; + } + } + $l && &sl("MODE $c -oooo $l"); + } elsif ($cmd eq 'W' || $cmd eq 'WHOIS') { + &sl($args eq '' ? "WHOIS $nick" : "WHOIS $args"); + } elsif ($cmd eq 'WI') { + &getarg; + $newarg=$nick if $newarg eq ''; + &sl("WHOIS $newarg $newarg"); + } elsif ($cmd eq 'WHO') { + &dosplat; + if ($args =~ /^[\s\*]*$/) { + &tell("*** Uhm, better not"); + } else { + &sl("WHO $args"); + } + } elsif ($cmd eq 'JOIN' || $cmd eq 'J') { + $args=$invited if $args eq ''; + if ($args !~ /^[\#\&\+]/) { + $query = $args; + } + elsif (grep(&eq($_, $args), @channels)) { +# &tell("*** Talking to $args now"); # KSIRC MOD + $talkchannel=$args; + $query = ""; + &dostatus; + } else { + &sl("JOIN $args"); + } + } elsif ($cmd eq 'UMODE') { + &sl("MODE $nick $args"); + } elsif ($cmd eq 'MO') { + if ($talkchannel) { + &sl("MODE $talkchannel $args"); + } else { + &tell("*\cbE\cb* You're not on any channel anyway"); + } + } elsif ($cmd eq 'LIST') { + &dosplat; + $listmin=0; + $listmax=100000; + $listpat=''; + if ($args =~ /\*/ || $args =~ /-m[ia][nx]\s/i) { + while (&getarg, $newarg ne '') { + if ($newarg =~ /^-min$/i) { + &getarg; + $listmin=$newarg if $newarg>0; + } elsif ($newarg =~ /^-max$/i) { + &getarg; + $listmax=$newarg if $newarg>0; + } else { + $newarg =~ s/([^\\])\./$1\\./g; + $newarg =~ s/\*/\.\*/g; + $newarg =~ s/([^\.\*\\\w])/\\$1/g; + $listpat=$newarg; + } + } + &sl("LIST"); + } else { + &sl($line); + } + } elsif ($cmd eq 'RPING') { + &getarg; + &sl("RPING $newarg ".time); + } elsif ($cmd eq 'KILL') { + &getarg; + if ($newarg) { + $args || ($args=$nick); + &sl("KILL $newarg :$args"); + } else { + &tell("*\cbE\cb* You must specify a nick!"); + } + } elsif ($cmd eq 'MODE' || $cmd eq 'NAMES') { + &dosplat; + &sl("$cmd $args"); + } elsif ($cmd eq 'OPER') { + &getarg; + $newarg=$nick unless $newarg; + &getuserpass("Oper password? ", "Passwd: "), $args=$_ unless $args; + &sl("OPER $newarg $args"); + } elsif ($cmd eq 'CONNECT') { + &getarg; + local($srv)=$newarg; + &getarg; + if ($args) { + &sl("CONNECT $srv $newarg $args"); + } else { + &sl("CONNECT $srv 6667 $newarg"); + } + } elsif ($cmd eq 'SQUIT') { + &getarg; + &sl("SQUIT $newarg :$args"); + } elsif ($cmd eq 'WHOWAS' || $cmd eq 'ADMIN' || $cmd eq 'STATS' || + $cmd eq 'INFO' || $cmd eq 'LUSERS' || $cmd eq 'SQUIT' || + $cmd eq 'REHASH' || $cmd eq 'DIE' || $cmd eq 'LINKS' || + $cmd eq 'NOTE' || $cmd eq 'WALLOPS' || $cmd eq 'NICK' || + $cmd eq 'MOTD' || $cmd eq 'TIME' || $cmd eq 'TRACE' || + $cmd eq 'USERS' || $cmd eq 'SILENCE' || $cmd eq 'MAP' || + $cmd eq 'UPING') { + &sl($line); + } else { + # Unknown command sucks. People want to use extensions like /nickserv, which works + # on some servers (Simon) + &sl($line); +# &tell("*\cbE\cb* Unknown command: $cmd"); + } +} + +sub douserline { + local($skip, $line)=(0, @_); + if ($line =~ /^\@ssfe\@/) { + $ssfe=$raw_mode=1; + $add_ons.="+ssfe"; + &dostatus; + } else { + &dohooks("command", $line); + return if $skip; + if ($line =~ s/^\///) { + &docommand($line); + } elsif ($query ne '') { + &msg($query, $line); + } else { + &say($line); + } + } +} + +$ssfe_getline="`#ssfe#p"; +sub getuserline { + local($skip)=''; + &dohooks("input", $_[0], $_[1]); + return if $skip; + print $_[0]; + print "\n" if $raw_mode; + print $ssfe_getline.$_[1]."\n" if $ssfe; + while (($_=<STDIN>) ne '') { + if (/^\@ssfe\@/) { + $ssfe || ($add_ons.="+ssfe"); + $ssfe=$raw_mode=1; + &dostatus; + } else { + &exit if $_ eq ''; + chop; + return; + } + } + &exit; +} + +sub getuserpass { + local($ssfe_getline)="`#ssfe#P"; + &getuserline; +} + +%cmds=(); +sub addcmd { + local($cmd)=$_[0]; + $cmd =~ tr/a-z/A-Z/; + $cmds{$cmd}="&cmd_".$_[0].";"; +} + +sub addhelp { + local($cmd, $txt)=@_; + $cmd =~ tr/A-Z/a-z/; + foreach (reverse(split(/\n/, $txt))) { + s/\$v/$version/g; + s/\$d/$date/g; + unshift (@help, $_); + } + unshift(@help, "\@".$cmd); +} + +sub addset { + local($var)=$_[0]; + $var =~ tr/a-z/A-Z/; + $sets{$var}="set_".$_[0]; +} + +sub addsel { + $buf_fds{$_[0]}="sel_".$_[1] if $_[2]; + $sel_fds{$_[0]}="sel_".$_[1] unless $_[2]; +} + +sub remsel { + delete $buf_fds{$_[0]}; + delete $sel_fds{$_[0]}; +} + +sub addwsel { + $sel_w_fds{$_[0]}="sel_".$_[1]; +} + +sub remwsel { + delete $sel_w_fds{$_[0]}; +} + +@hooks=("action", "ctcp", "ctcp_reply", "dcc_chat", "dcc_request", "input", + "invite", "join", "kick", "leave", "mode", "msg", "nick", "notice", + "server_notice", "notify_signoff", "notify_signon", "public", + "raw_irc", "send_action", "send_dcc_chat", "send_text", "send_notice", + "signoff", "topic", "disconnect", "status", "print", "command", + "chat_disconnect", "dcc_disconnect", "send_ctcp", + "dcc_send", "dcc_send_status", "dcc_get", "dcc_get_status", "quit", + "pong"); # ksirc additions + +sub addhook { + local($type, $name)=@_; + $type =~ tr/A-Z/a-z/; + $name="hook_".$name; + if ($type =~ /^\d\d\d$/ || grep(($_ eq $type), @hooks)) { + ($type =~ /^\d\d\d$/) && ($type="num_".$type); + eval "*ugly_hack_hooks=*${type}_hooks;"; + unless (grep(($_ eq $name), @ugly_hack_hooks)) { + push(@ugly_hack_hooks, $name); + } + } else { + &tell("*\cbE\cb* $type: no such hook"); + } +} + +sub remhook { + local($type, $name)=@_; + $type =~ tr/A-Z/a-z/; + $name="hook_".$name; + if ($type =~ /^\d\d\d$/ || grep(($_ eq $type), @hooks)) { + ($type =~ /^\d\d\d$/) && ($type="num_".$type); + eval "*ugly_hack_hooks=*${type}_hooks;"; + @ugly_hack_hooks=grep(($_ ne $name), @ugly_hack_hooks); + } else { + &tell("*\cbE\cb* $type: no such hook"); + } +} + +sub userhost { + push (@waituh, $_[0]); + push (@douh, $_[1]); + push (@erruh, $_[2]); + &sl("USERHOST $_[0]"); +} + +sub deltimer { + local($ref)=$_[0]; + local($i); + if ($#trefs>=0 && $ref!=0) { + # delete the timer if it exists + for ($i=0; $i<=$#trefs; $i++) { + if ($trefs[$i]==$ref) { + splice(@trefs,$i,1); + splice(@timers,$i,1); + splice(@timeactions,$i,1); + last; + } + } + } +} + +sub timer { + local(@r, @t, @a)=(); + local($t)=$_[0]+time; + local($ref)=$_[2] || 0; + &deltimer($ref) if $ref; + while ($#timers>=0 && $timers[0]<=$t) { + push (@r, shift(@trefs)); + push (@t, shift(@timers)); + push (@a, shift(@timeactions)); + } + @trefs=(@r, $ref, @trefs); + @timers=(@t, $t, @timers); + @timeactions=(@a, $_[1], @timeactions); +} + +sub disappeared { + local($n)=(grep(&eq($_, $_[0]), keys(%notify))); + if ($n ne '' && $notify{$n}>0) { + local($silent)=0; + &dohooks("notify_signoff", $_[0]); + &tell("*\cb(\cb* Signoff by $_[0] detected"); + $notify{$n}=0; + } +} + +sub appeared { + local($t, $n)=(time, grep(&eq($_, $_[0]), keys(%notify))); + if ($n ne '') { + if ($notify{$n}==0) { + local($silent)=0; + &dohooks("notify_signon", $_[0]); + &tell("*\cb)\cb* Signon by $_[0] detected!"); + } + else { +# &tell("*\cb(\cb* Signoff by $_[0] detected!"); + } + $notify{$n}=$t; + } +} + +$lastsendison=0; +sub send_isons { + local($l)=''; + foreach (keys %notify) { + &sl("ISON : $l"), $l='' if (length($l)>500); + $l.=$_." "; + } + &sl("ISON :$l") if $l; + $lastsendison=time; + $newisons=''; + $checkisons=1; +} + +sub signoffs { + foreach (keys %notify) { + if ($notify{$_}>0 && $notify{$_}<$lastsendison) { + $notify{$_}=0; + local($silent)=0; + &dohooks("notify_signoff", $_); + &tell("*\cb(\cb* Signoff by $_ detected"); + } + } + $checkisons=''; +} + +sub modestripper { + local($chnl, $what)=@_; + $chnl =~ tr/A-Z/a-z/; + local($how, $modes, @args)=('+', split(/ +/, $what)); + foreach $m (split(//, $modes)) { + if ($m =~ /[\-\+]/) { + $how=$m; + } elsif ($m =~ /[vb]/) { + shift(@args); + } elsif ($m eq 'k') { + $how eq '+' ? ($chankey{$chnl}=$args[0]) : delete $chankey{$chnl}; + shift(@args); + } elsif ($m eq 'l') { + $how eq '+' ? ($limit{$chnl}=shift(@args)) : delete $limit{$chnl}; + } elsif ($m eq 'o') { + $haveops{$chnl}=($how eq '+') if (&eq(shift(@args), $nick)); + } else { + $mode{$chnl} =~ s/$m//g; + $mode{$chnl}.=$m if $how eq '+'; + } + } +} + +sub umodechange { + local($what)=@_; + local($how)='+'; + foreach $m (split(//, $what)) { + if ($m =~ /[\-\+]/) { + $how=$m; + } else { + $umode =~ s/$m//g; + $umode.=$m if ($how eq '+' && $m !~ /\s/); + } + } +} + +sub ignored { + foreach (@ignore) { + return 1 if $_[0] =~ /^${_}$/; + } + return ''; +} + +sub dorcfile { + return if !open(RCFILE, "<$_[0]"); + while (<RCFILE>) { + chop; + s/^\///; + next if /^\#/; + &docommand($_) if $_; + $silent=$skip=''; + } + close RCFILE; +} + +sub loadrc { + $rcloaded=1; + $sysrc && &dorcfile($sysrc); + $rcfile && &dorcfile($rcfile); +} + +sub selline { + $leftover=0; + $rin=$rout="\0" x 32; + $win=$wout="\0" x 32; + foreach ($S, 'STDIN', keys(%dcnick), keys(%buf_fds)) { + $leftover=1, return $_ if $buffer{$_} =~ /\n/; + } + foreach ('STDIN', keys(%dcnick), keys(%dcwait), keys(%dgrfh), keys(%dswait), + keys(%dsrfh), keys(%sel_fds), keys(%buf_fds)) { + vec($rin, fileno($_), 1)=1; + } + foreach (keys(%sel_w_fds)){ + vec($win, fileno($_), 1)=1; + } + vec($rin, fileno($S), 1)=1 if $connected; + if ($#timers<0 || $timers[0]>time+30) { + select($rout=$rin, $wout=$win, undef, 30); + } elsif ($timers[0]<=time) { + select($rout=$rin, $wout=$win, undef, 0); + } else { + select($rout=$rin, $wout=$win, undef, $timers[0]-time); + } +} + +sub getnick { + if ($ENV{'BACKUPNICK'} && !($nick eq $ENV{'BACKUPNICK'})) { + $nick=$ENV{'BACKUPNICK'}; + } else { + &getuserline("Pick a nick: ", "Nick: "); + $nick=$_; + } + &sl("NICK $nick"); + &dostatus; +} + +sub donumeric { + local($from)=($who eq $myserver ? '' : " (from ${who})"); + if ($cmd eq '401') { + &yetonearg; + &yetonearg; + &tell("*\cb?\cb* Cannot find $newarg on irc$from"); + } elsif ($cmd eq '402') { + &yetonearg; + &yetonearg; + &tell("*\cb?\cb* $newarg: no such server$from"); + } elsif ($cmd eq '403') { + &yetonearg; + &yetonearg; + &tell("*\cb?\cb* $newarg: no such channel$from"); + } elsif ($cmd eq '406') { + &yetonearg; + &yetonearg; + &tell("*\cb?\cb* $newarg: there was no such nickname$from"); + } elsif ($cmd eq '421') { + &yetonearg; + &yetonearg; + &tell("*\cb?\cb* $newarg: unknown command$from"); + } elsif ($cmd =~ /^4[012]/) { + $args =~ s/^[^:]*://; + &tell("*** $args$from"); + } elsif ($cmd eq '431') { + &tell("*** Was expecting a nickname somewhere..."); + &getnick if $connected<2; + } elsif ($cmd eq '432') { + if ($connected==2) { + &tell("*\cbN\cb* Invalid nickname, you're still \"$nick\""); + } else { + &tell("*\cbN\cb* Invalid nickname!"); + &getnick; + } + } elsif ($cmd eq '433') { + if ($connected==2) { + &tell("*\cbN\cb* Nick already taken, you're still \"$nick\""); + } else { + &tell("*\cbN\cb* Nick already taken!"); + &getnick; + } + } elsif ($cmd eq '441') { + local($g, $w, $c)=split(/ +/, $args); + &tell("*\cbE\cb* $w is not on channel $c$from"); + } elsif ($cmd eq '442') { + local($w, $c)=split(/ +/, $args); +# &tell("*\cbE\cb* You're not on channel $c$from"); # KSIRC MOD + } elsif ($cmd eq '443') { + local($w, $o, $c)=split(/ +/, $args); + &tell("*\cbE\cb* $o is already on channel $c$from"); + } elsif ($cmd eq '465') { + &tell("*\cbE\cb* You are banned from this server$from"); + } elsif ($cmd eq '461') { + &yetonearg; + &yetonearg; + &tell("*\cbE\cb* The command $newarg needs more arguments than that$from"); + } elsif ($cmd =~ /^47[1345]$/) { + &yetonearg; + &yetonearg; + local($r); + if ($cmd eq '471') { + $r="channel is full"; + } elsif ($cmd eq '473') { + $r="channel is invite-only"; + } elsif ($cmd eq '474') { + $r="banned from channel"; + } else { + $r="bad channel key"; + } + &tell("*\cbE\cb* Can't join $newarg: ${r}$from"); + } elsif ($cmd eq '301') { + &yetonearg; + &yetonearg; + &tell("*** $newarg is away: $args"); + } elsif ($cmd eq '302') { + &yetonearg; + &yetonearg; + local($n, $do, $err)=(shift(@waituh), shift(@douh), shift(@erruh)); + if ($newarg =~ /^([^\s\*=]+)[\*]?=([\-+])/) { + $who=$1; + local($adr)=$'; + if ($adr =~ /\@/) { + $user=$`; + $host=$'; + } else { + $user=$host=''; + } + if (&eq($who, $n)) { + eval $do; + $@ =~ s/\n$//, &tell("*\cbE\cb* error in userhost: $@") if $@ ne ''; + } else { + &tell("*\cbE\cb* userhost returned for unexpected nick $who"); + } + } else { + if (defined($err)) { + eval $err; + $@ =~ s/\n$//, &tell("*\cbE\cb* error in userhost: $@") if $@ ne ''; + } else { + &tell("*\cb?\cb* Cannot find $n on irc"); + } + } + } elsif ($cmd eq '303') { + &yetonearg; + local($n); + foreach $n (split(/ +/, $args)) { + &appeared($n); + } + } elsif ($cmd eq '305') { + &tell("*** You are no longer marked as away"); + $away=''; + &dostatus; + } elsif ($cmd eq '306') { + &tell("*** You are marked as being away"); + $away=1; + &dostatus; + } elsif ($cmd eq '311') { + local($g, $n, $u, $m, $g, $r)=split(/ +/, $args, 6); + $r =~ s/^://; + &tell("*** $n is $u\@$m ($r)"); + } elsif ($cmd eq '312') { + &yetonearg; + &yetonearg; + &yetonearg; + local($s)=$newarg; + &tell("*** on IRC via server $s ($args)"); + } elsif ($cmd eq '313') { + &yetonearg; + &yetonearg; + &tell("*** $newarg $args"); + } elsif ($cmd eq '314') { + local($g, $n, $u, $m, $g, $r)=split(/ +/, $args, 6); + $r =~ s/^://; + &tell("*** $n was $u\@$m ($r)"); + } elsif ($cmd eq '317') { + &yetonearg; + &yetonearg; + local($n)=$newarg; + &yetonearg; + if ($newarg>=3600) { + &tell("*** $n has been idle for ".int($newarg/3600)." hours, ". + int(($newarg%3600)/60)." minutes and ". + ($newarg%60)." seconds"); + } elsif ($newarg>=60) { + &tell("*** $n has been idle for ".int($newarg/60)." minutes and ". + ($newarg%60)." seconds"); + } else { + &tell("*** $n has been idle for $newarg seconds"); + } + } elsif ($cmd eq '319') { + local($g, $g, $c)=split(/ +/, $args, 3); + $c =~ s/^://; + &tell("*** on channels: $c"); + } elsif ($cmd eq '322') { + local($g, $c, $n, $r)=split(/ +/, $args, 4); + $r =~ s/^://; + $n>=$listmin && $n <=$listmax && (!$listpat || $c =~ /^${listpat}$/i) + && &tell(sprintf("*** %-10s %-5s %s", $c, $n, $r)); + } elsif ($cmd eq '323') { + $listmin=0; + $listmax=100000; + $listpat=''; + } elsif ($cmd eq '324') { + local($g, $c, $m)=split(/ +/, $args, 3); + $m =~ s/^://; + $m =~ s/ $//; + $c =~ tr/A-Z/a-z/; + if (grep(&eq($_, $c), @channels)) { + if (defined($mode{$c})) { + &tell("*\cb+\cb* Mode for channel $c is \"$m\""); + } else { + $mode{$c}=''; + } + &modestripper($c, $m); + &dostatus; + } else { + &tell("*\cb+\cb* Mode for channel $c is \"$m\""); + } + } elsif ($cmd eq '329') { + &yetonearg; + &yetonearg; + local($c)=$newarg; + &yetonearg; + local($t)=($newarg ? ("created " . &date($newarg)) : "0 TS"); + &tell("*** $c : $t"); + } elsif ($cmd eq '331') { + &yetonearg; + &yetonearg; + &tell("*\cbT\cb* No topic is set on channel $newarg"); + } elsif ($cmd eq '332') { + &yetonearg; + &yetonearg; + &tell("*\cbT\cb* Topic for $newarg: $args"); + } elsif ($cmd eq '333') { + local($g, $c, $n, $t)=split(/ +/, $args, 4); + local($d)=&date($t); + &tell("*\cbT\cb* Topic for $c set by $n on $d"); + } elsif ($cmd eq '318' || $cmd eq '315' || $cmd eq '369' || + $cmd eq '321' || $cmd eq '376' || # KSIRC MOD + $cmd eq '365' || $cmd eq '368' || $cmd eq '374' || + $cmd eq '219' || $cmd eq '007') { + #nothing! + } elsif ($cmd eq '341') { + local($g, $n, $c)=split(/ +/, $args, 3); + &tell("*\cbI\cb* Inviting $n to channel $c"); + } elsif ($cmd eq '352') { + local($g, $c, $u, $m, $s, $n, $st, $g, $i)=split(/ +/, $args, 9); + &tell(sprintf("%-10s %-9s %4s %s\@%s (%s)", $c, $n, $st, $u, $m, $i)); + } elsif ($cmd eq '353') { + local($g, $m, $c, $r)=split(/ +/, $args, 4); + local($n)=$nick; + $n =~ s/(\W)/\\$1/g; + $r =~ s/^://; + if($DSIRC_NAMES eq ''){ #KSIRC MOD + &tell("*I* Users on $c: $r"); # KSIRC MOD + $DSIRC_NAMES = $c; # KSIRC MOD + } # KSIRC MOD + else { # KSIRC MOD + &tell("*\cbI\cb* Users on $c: $r"); # KSIRC MOD + } # KSIRC MOD + $c =~ tr/A-Z/a-z/; + $haveops{$c}=1 if ($r =~ /\@${n}( |$)/i); + &dostatus if &eq($c, $talkchannel); + } elsif ($cmd eq '366'){ # KSIRC MOD + #&tell("*I* Users on $DSIRC_NAMES:"); # KSIRC MOD + $DSIRC_NAMES = ''; # KSIRC MOD + } elsif ($cmd eq '221') { + &yetonearg; + &tell("*\cb+\cb* Your user mode is \"$args\""); + } elsif ($cmd eq '200') { + local($b, $l, $v, $n, $s)=split(/ +/, $args); + $s =~ s/^://; + &tell("*** $l $who ($v) ==> $n $s"); + } elsif ($cmd eq '205') { + local($b, $u, $h, $n)=split(/ +/, $args); + $n =~ s/^://; + &tell("*** $u [$h] ==> $n"); + } elsif ($cmd =~ /^20/) { + local($b, $t, $n, $r)=split(/ +/, $args, 4); + &tell("*** $t [$n] ==> $r"); + } elsif ($cmd eq '375' || $cmd eq '372' || $cmd =~ /^25/) { + &yetonearg; + &tell("*** $args"); + } elsif ($cmd eq '379' ) { # RPL_FORWARD (Simon) + &yetonearg; + local( $from_channel, $to_channel ) = split( / +/, $args ); + &tell("~$from_channel~*\cb<\cb* You have left channel $from_channel"); + } else { + &yetonearg; + #$args =~ s/ :/ /; + &tell("*** $args$from"); + } +} + +# main prog + +print "`#ssfe#i\n" unless (-t STDOUT); +&tell("*** Welcome to \cbsirc\cb version $version; type /help for help"); + +&load($sysinit) if $sysinit ne '' && -f $sysinit; +&load($initfile) if !$restrict && $initfile ne '' && -f $initfile; + +while (1) { + &bindtoserver, undef $ready if $ready; + $silent=$skip=''; + if ($connected==2) { + $time=time; + &loadrc unless $rcloaded; + &send_isons + if $time>=$lastsendison+90 || ($newisons && $time>=$lastsendison+10); + &signoffs if $checkisons && ($time>=$lastsendison+30); + } + $fh=&selline; + foreach $rfh (keys (%buf_fds)) { + if (vec($rout, fileno($rfh), 1) || ($leftover && $fh eq $rfh)) { + &gl($rfh) || next; + local($line, $h)=($_, $buf_fds{$rfh}); + delete $buf_fds{$rfh}, delete $buffer{$rfh}, close($rfh) if $_ eq ''; + eval { &$h($line); }; + $@ =~ s/\n$//, &tell("*\cbE\cb* error in buffered fd hook &$h: $@") + if $@ ne ''; + } + } + foreach $rfh (keys (%sel_fds)) { + if (vec($rout, fileno($rfh), 1)) { + local($h)=$sel_fds{$rfh}; + eval { &$h($rfh); }; #KSIRC MOD + $@ =~ s/\n$//, &tell("*\cbE\cb* error in unbuffered fd hook &$h: $@") + if $@ ne ''; + } + } + foreach $rfh (keys (%sel_w_fds)) { + if (vec($wout, fileno($rfh), 1)) { + local($h)=$sel_w_fds{$rfh}; + eval { &$h($rfh); }; #KSIRC MOD + $@ =~ s/\n$//, &tell("*\cbE\cb* error in unbuffered fd hook &$h: $@") + if $@ ne ''; + } + } + foreach $rfh (keys (%dcnick)) { + if (vec($rout, fileno($rfh), 1) || ($leftover && $fh eq $rfh)) { + &gl($rfh) || next; + &dcerror($rfh), next if $_ eq ''; + chop; + local($who, $what)=($dcnick{$rfh}, $_); + $dcvol{$dcnick{$rfh}}+=length($what); + print "`#ssfe#t/m =$who \n" if $ssfe; + print "`#ssfe#o=${who}= $what\n" if $ssfe; + &dohooks("dcc_chat", $who, $what); + &tell("~=${who}~=\cb${who}\cb= $what"); # KSIRC MOD + $silent=''; + } + } + foreach $rfh (keys (%dcwait)) { + if (vec($rout, fileno($rfh), 1)) { + local($n, $fh); + my $paddr; + if ($paddr = &accept($fh, $rfh)) { + select($fh); $|=1; select(STDOUT); + my($port,$iaddr) = sockaddr_in($paddr); + my $ip = inet_ntoa($iaddr); + $n=$dcwait{$rfh}; + $dcnick{$fh}=$n; + $n =~ tr/A-Z/a-z/; + $dcvol{$n}=0; + $dcfh{$n}=$fh; + &tell("*\cbD\cb* DCC CHAT connection with $n established"); + &tell("~!dcc~DCC CHAT inbound established who: $n ip: $ip"); + print "`#ssfe#t/m =$n \n" if $ssfe; + } + delete $dcwait{$rfh}; + } + } + foreach $sfh (keys (%dswait)) { + local($rfh, $fh)=$dswait{$sfh}; + if (vec($rout, fileno($sfh), 1)) { + my $paddr; + if ($paddr = &accept($fh, $sfh)) { + my($port,$iaddr) = sockaddr_in($paddr); + my $ip = inet_ntoa($iaddr); + select($fh); $|=1; select(STDOUT); + $dsrfh{$fh}=$rfh; + $dstarttime{$rfh}=time; + $dtransferred{$fh}=0; + $dnick{$fh}=$dnick{$sfh}; + $dsoffset{$fh}=$dsoffset{$sfh}; + &tell("*\cbD\cb* DCC SEND connection with $dnick{$sfh}/$ip ($dfile{$rfh}) established"); + &tell("~!dcc~DCC SEND established who: $dnick{$sfh} file: $dfile{$rfh} ip: $ip"); + } + delete $dnick{$sfh}; + delete $dswait{$sfh}; + delete $dsoffset{$sfh}; + delete $dsport{$sfh}; + } + } + foreach $sfh (keys (%dgrfh)) { + local($rfh)=$dgrfh{$sfh}; + if (vec($rout, fileno($sfh), 1)) { + local($a, $buf)=(0, ''); + $a=sysread($sfh, $buf, 4096); + if ($a) { + $dtransferred{$sfh}+=$a; + &dohooks("dcc_get_status", $dfile{$rfh}, $dtransferred{$sfh}, $rfh); + # &tell("*\cbD\cb* DCC GET read: $dfile{$rfh} bytes: $dtransferred{$sfh}"); # KSIRC MOD FOR 971217 + my $b = $dtransferred{$sfh}+$dgxferadd{$sfh}; + &tell("~!dcc~DCC GET read: $dfile{$rfh} who: $dnick{$sfh} bytes: $b"); # KSIRC MOD FOR 971217 + print $rfh $buf; + print $sfh pack("N", $b); # used to be just $dtransfered but most seem to want xfet + offset + } else { + &dgsclose($sfh, $rfh, "GET", "OK"); + } + } + } + foreach $sfh (keys (%dsrfh)) { + local($rfh)=$dsrfh{$sfh}; + if (vec($rout, fileno($sfh), 1) || !$dtransferred{$sfh}) { + local($ack, $csa, $buf, $b, $l, $w)=(0, '', ''); + if ($dtransferred{$sfh}) { + &dgsclose($sfh, $rfh, "SEND", "Protocol Error"), next if sysread($sfh, $b, 4)!=4; + $ack=unpack("N", $b); + } + if($ack > ($dtransferred{$sfh} + $dsoffset{$sfh})){ + my $v = $dtransferred{$sfh} + $dsoffset{$sfh}; + &tell("*\cbD\cb* DCC transfer protocol failure! $ack $dtransferred{$sfh} $dsoffset{$sfh} $v"); + &dgsclose($sfh, $rfh, "SEND", "Protocol Out of Sync"); + next; + } + # + # When you do a dcc resume the ack value returned from the + # remote client is not well defined. Two different values + # are used, the current number of bytes transfered, or + # the current location in the file. We try to detech + # which type of ack we got and we adjust our math + # according so we keep up nice packet sizes. + # xchat can't seem to take > 4k packets after a resume + # and it causes the backoff to ack a little funny, but + # it's not our fault! + # + if($dsoffset{$sfh} && ($ack != 0) && ($dsresumedb{$sfh} == undef)) { + if($ack > $dsoffset{$sfh}){ + $dsresumedb{$sfh} = 1; + } + else { + $dsresumedb{$sfh} = 2; + } + #&print("*** Resume style is: $dsresumedb{$sfh}"); + + } + if($dsoffset{$sfh} && ($dsresumedb{$sfh} == 1)){ + $csa=$set{"SENDAHEAD"}-($dtransferred{$sfh}+$dsoffset{$sfh})+$ack; + } + else { + $csa=$set{"SENDAHEAD"}-$dtransferred{$sfh}+$ack; + } + #&print("*** CSA is: $csa ack: $ack dt: $dtransferred{$sfh} $dsoffset{$sfh}"); + next if $csa<0; + $l=read($rfh, $buf, 512+$csa); + $w=syswrite($sfh, $buf, $l) if $l; + &dohooks("dcc_send_status", $dfile{$rfh}, $dtransferred{$sfh}, $rfh); + # &tell("*\cbD\cb* DCC SEND write: $dfile{$rfh} bytes: $dtransferred{$sfh}"); # KSIRC MOD FOR 971218 + my $sz = $dtransferred{$sfh}+$dsoffset{$sfh}; + &tell("~!dcc~DCC SEND write: $dfile{$rfh} who: $dnick{$sfh} bytes: $sz"); # KSIRC MOD FOR 971218 + next if $l==0 && $ack<$dtransferred{$sfh}; + $dtransferred{$sfh}+=$w; + &dgsclose($sfh, $rfh, "SEND", "OK"), next if ($w<$l || $l==0); + } + } + while ($#timers>=0 && $timers[0]<=time) { + shift (@timers); + shift (@trefs); + eval shift (@timeactions); + $@ =~ s/\n$//, &tell("*\cbE\cb* error in timer: $@") if $@ ne ''; + } + if (vec($rout, fileno(STDIN), 1) || ($leftover && $fh eq 'STDIN')) { + &gl('STDIN') || next; + &exit if $_ eq ''; + chop; + $logging && print LOG "<- " . $_ . "\n"; + &douserline($_) if $_ ne ''; + } + if ($connected && (($leftover && $fh eq $S) || vec($rout, fileno($S), 1))) { + &gl($S) || next; + if ($_ eq '') { + &tell("*\cbE\cb* Connection to server lost"); + close($S); + delete $buffer{$S}; + $connected=0; + &dohooks("disconnect"); + &bindtoserver; + next; + } + chop; + $logging && print LOG ">> " . $_ . "\n"; + $serverline=$_; + $_=$server." ".$_ unless /^:/; + ($who, $cmd, $args)=split(/ /, $_, 3); + $cmd =~ tr/a-z/A-Z/; + $who =~ s/^://; + $args =~ s/^://; + $user=$host=$puh1=$puh2=''; + if ($who =~ /^([^!@ ]+)!([^@ ]+)@([^ ]+)$/) { + ($who, $user, $host) = ($1, $2, $3); + $puh1="!$user\@$host" if $set{"PRINTUH"} ne 'none'; + $puh2=$puh1 if $set{"PRINTUH"} eq 'all'; + } + &dohooks("raw_irc", $cmd, $args); + next if $skip; + next if (($cmd eq 'PRIVMSG' || $cmd eq 'NOTICE') && + &ignored("$who!$user\@$host")); + if ($cmd eq '001') { + $connected=2; + $myserver=$who; + ($nick)=split(/ /, $args, 2); + } + if ($cmd =~ /^\d\d\d$/) { + &dohooks("num_".$cmd, $args); + next if $skip; + &donumeric; + } elsif ($cmd eq 'PING') { + &sl("PONG $args"); + } elsif ($cmd eq 'PRIVMSG') { + &yetonearg; + if ($args =~ /^\001([^\001]*)\001$/ && $set{'CTCP'} ne 'none') { + &ctcp($newarg, $1); + } elsif (!$printchan && &eq($newarg, $talkchannel)) { + &dohooks("public", $newarg, $args); + &tell("~${newarg}~<${who}> $args"); # MOD FOR KSIRC + } elsif ($newarg =~ /^[\#\&\+]/) { + &dohooks("public", $newarg, $args); + &tell("~${newarg}~<${who}> $args"); # MOD FOR KSIRC + } elsif (&eq ($newarg, $nick)) { + print "`#ssfe#t/m $who \n" if $ssfe; + print "`#ssfe#o[$who$puh1] $args\n" if $ssfe; + &dohooks("msg", $args); + &tell("~${who}~[\cb${who}\cb${puh1}] $args"); # MOD FOR KSIRC + } else { + &tell("~${who}~[\cb${who}\cb${puh1}\cb] $args"); # MOD FOR KSIRC + } + } elsif ($cmd eq 'NOTICE') { + &yetonearg; + if ($args =~ /^\001([^\001]*)\001$/) { + &ctcpreply($newarg, $1); + } elsif ($newarg =~ /^[\#\&\+]/) { + &dohooks("notice", $newarg, $args); + &tell("~${newarg}~-${who}- $args"); # MOD FOR KSIRC + } elsif ($who =~ /\./) { + &dohooks("server_notice", $args); + $args="*** ".$args unless ($args =~ /^\*/); + &tell($args); + } elsif (&eq($newarg, $nick)) { + &dohooks("notice", $newarg, $args); + &tell("~${who}~-\cb${who}\cb${puh1}- $args"); # MOD FOR KSIRC + } else { + &dohooks("notice", $newarg, $args); + &tell("~${who}~-\cb$who$puh1\cb- $args"); # MOD FOR KSIRC + } + $newarg =~ s/\cg.*//; # ircnet kludge + } elsif ($cmd eq 'KICK') { + &yetonearg; + local($channel)=$newarg; + &yetonearg; + $args=$who unless $args; + if (&eq($nick, $newarg)) { + &tell("~${channel}~*\cb<\cb* You have been kicked off channel $channel by $who$puh2 ($args)"); # MOD FOR KSIRC + @channels=grep(!&eq($_, $channel), @channels); + if (@channels) { + $talkchannel=$channels[$#channels]; + } else { + $talkchannel=''; + } + $channel =~ tr/A-Z/a-z/; + &dohooks("kick", $newarg, $channel, $args); + delete $mode{$channel}; + delete $limit{$channel}; + delete $haveops{$channel}; + delete $chankey{$channel}; + $talkchannel && !$ssfe && &tell("*** Talking to $talkchannel now"); + &dostatus; + } else { + &dohooks("kick", $newarg, $channel, $args); + &tell("~${channel}~*\cb<\cb* $newarg has been kicked off channel $channel by $who$puh2 ($args)"); # MOD FOR KSIRC + } + } elsif ($cmd eq 'PART') { + &yetonearg; + if (&eq($who, $nick)) { + #&tell("~!all~*\cb<\cb* You have left channel $newarg"); # MOD FOR KSIRC + @channels=grep(!&eq($_, $newarg), @channels); + if (@channels) { + $talkchannel=$channels[$#channels]; + } else { + $talkchannel=''; + } + $newarg =~ tr/A-Z/a-z/; + delete $mode{$newarg}; + delete $limit{$newarg}; + delete $haveops{$newarg}; + delete $chankey{$newarg}; + &dohooks("leave", $newarg); + $talkchannel && !$ssfe && &tell("*** Talking to $talkchannel now"); + &dostatus; + } else { + &dohooks("leave", $newarg); + &tell("~${newarg}~*\cb<\cb* $who$puh2 has left channel $newarg"); # MOD FOR KSIRC + } + } elsif ($cmd eq 'JOIN') { + &yetonearg; + if (&eq($nick, $who)) { + $newarg =~ tr/A-Z/a-z/; + push(@channels, $newarg); + $talkchannel=$newarg; + &dohooks("join", $newarg); + &dostatus; + &tell("~${newarg}~*\cb>\cb* You have joined channel $newarg"); # MOD FOR KSIRC + &sl("MODE $newarg"); + } else { + &dohooks("join", $newarg); + &tell("~${newarg}~*\cb>\cb* $who ($user\@$host) has joined channel $newarg"); # MOD FOR KSIRC + } + &appeared($who); + } elsif ($cmd eq 'NICK') { + &yetonearg; + if (&eq($nick, $who)) { + $oldnick = $nick; + $nick=$newarg; + &dohooks("nick", $newarg); + $who=$newarg; + &dostatus; + &tell("~!all~*\cbN\cb* $oldnick is now known as $newarg"); + } else { + &dohooks("nick", $newarg); + &tell("~!all~*\cbN\cb* $who$puh2 is now known as $newarg"); # MOD FOR KSIRC + } + } elsif ($cmd eq 'MODE') { + &yetonearg; + $args =~ s/ $//; + if ($newarg =~ /^[\#\&\+]/) { + &modestripper($newarg, $args); + &dohooks("mode", $newarg, $args); + &dostatus; + &tell("~${newarg}~*\cb+\cb* Mode change \"$args\" on channel $newarg by $who$puh2"); # MOD FOR KSIRC + } else { + local($towho)=$newarg; + &yetonearg; + &umodechange($newarg), &dostatus if &eq($towho, $nick); + &dohooks("mode", $towho, $newarg); + &tell("*\cb+\cb* Mode change \"$newarg\" for user $towho by $who"); # MOD FOR KSIRC + } + } elsif ($cmd eq 'KILL') { + &yetonearg; + local($n)=$newarg; + $args || ($args=$who); + &tell("~${newarg}~*\cb<\cb* $n got killed by $who$puh1 ($args)"); # MOD FOR KSIRC + } elsif ($cmd eq 'INVITE') { + &yetonearg; + &yetonearg; + &dohooks("invite", $newarg); + $invited=$newarg; + &tell("~!default~*\cbI\cb* $who$puh1 invites you to channel $newarg"); # MOD FOR KSIRC + } elsif ($cmd eq 'TOPIC') { + &yetonearg; + &dohooks("topic", $newarg, $args); + &tell("~${newarg}~*\cbT\cb* $who$puh2 has changed the topic on channel $newarg to \"$args\""); # MOD FOR KSIRC + } elsif ($cmd eq 'SILENCE') { + &tell("*** Silence $args"); + } elsif ($cmd eq 'PONG') { + &dohooks("pong", $args); + } elsif ($cmd eq 'QUIT') { + &dohooks("signoff", $args); + &tell("~!all~*\cb<\cb* Signoff: $who$puh2 ($args)"); # MOD FOR KSIRC + &disappeared($who); + } elsif ($cmd eq 'WALLOPS') { + &tell("!$who$puh2! ".$args); + } elsif ($cmd eq 'RPONG') { + local($n, $t, $ms, $ts)=split(/ +/, $args); + $ts =~ s/^://; + &tell("*** RPONG: $who - $t: $ms ms, ".time-$ts." sec"); + } else { + &tell("*** The server says: $serverline"); + } + } +} + |