# Created: 20000707 (from UserExtra.pl)
#
-if (&IsParam("useStrict")) { use strict; }
+use strict;
+
+use vars qw(%users %ignore %sched %bans %mask %cache %channels %param
+ %chanconf %dcc);
+use vars qw($who $chan $message $msgType $user $chnick $conn $ident
+ $verifyUser $ucount_userfile $utime_userfile $lobotomized
+ $utime_chanfile $ucount_chanfile);
+use vars qw(@backlog);
sub userDCC {
# hrm...
# quit.
if ($message =~ /^(exit|quit)$/i) {
# do ircII clients support remote close? if so, cool!
- &status("userDCC: quit called. FIXME");
+ &FIXME("userDCC: quit called.");
&dcc_close($who);
- &status("hrmm....");
+ &status("userDCC: after dcc_close!");
return;
}
# who.
if ($message =~ /^who$/) {
- my $count = scalar(keys %{$dcc{'CHAT'}});
+ my $count = scalar(keys %{ $dcc{'CHAT'} });
my $dccCHAT = $message;
&pSReply("Start of who ($count users).");
- foreach (keys %{$dcc{'CHAT'}}) {
+ foreach (keys %{ $dcc{'CHAT'} }) {
&pSReply("=> $_");
}
&pSReply("End of who.");
### for those users with enough flags.
+ if ($message =~ /^tellme(\s+(.*))?$/i) {
+ my $args = $2;
+ if ($args =~ /^\s*$/) {
+ &help("tellme");
+ return;
+ }
+
+ my $result = &doQuestion($args);
+ &pSReply($result);
+
+ return;
+ }
+
# 4op.
if ($message =~ /^4op(\s+($mask{chan}))?$/i) {
return unless (&hasFlag("o"));
return;
}
+ # dump variables ][.
+ if ($message =~ /^symdump$/i) {
+ return unless (&hasFlag("o"));
+ return unless (&IsParam("symdump"));
+
+ &status("Dumping all variables...");
+ &symdumpAllFile();
+
+ return;
+ }
+
# kick.
- if ($message =~ /^kick(\s+(\S+)(\s+(\S+))?)?/) {
+ if ($message =~ /^kick(\s+(.*?))$/) {
return unless (&hasFlag("o"));
- my ($nick,$chan) = (lc $2,lc $4);
- if ($nick eq "") {
+ my $arg = $2;
+
+ if ($arg eq "") {
&help("kick");
return;
}
+ my @args = split(/\s+/, $arg);
+ my ($nick,$chan,$reason) = @args;
if (&validChan($chan) == 0) {
&msg($who,"error: invalid channel \002$chan\002");
return;
}
- &kick($nick,$chan);
+ &kick($nick,$chan,$reason);
return;
}
- # kick.
+ # mode.
if ($message =~ /^mode(\s+(.*))?$/) {
- return unless (&hasFlag("m"));
+ return unless (&hasFlag("n"));
my ($chan,$mode) = split /\s+/,$2,2;
if ($chan eq "") {
# unlobotomy.
if ($message =~ /^(unlobotomy|benoisy)$/i) {
return unless (&hasFlag("o"));
+
if ($lobotomized) {
&performReply("i have been unlobotomized, woohoo");
$lobotomized = 0;
+ delete $cache{lobotomy};
+# undef $cache{lobotomy}; # ??
} else {
&performReply("i'm not lobotomized");
}
+
return;
}
next unless (&IsNickInChan($opee,$_));
$found++;
if ($channels{$_}{'o'}{$opee}) {
- &status("op: $opee already has ops on $_");
+ &pSReply("op: $opee already has ops on $_");
next;
}
$op++;
- &status("opping $opee on $_ at ${who}'s request");
&pSReply("opping $opee on $_");
&op($_, $opee);
}
if ($found != $op) {
- &status("op: opped on all possible channels.");
+ &pSReply("op: opped on all possible channels.");
} else {
- &DEBUG("found => '$found'.");
- &DEBUG("op => '$op'.");
+ &DEBUG("op: found => '$found'.");
+ &DEBUG("op: op => '$op'.");
}
return;
if ($message =~ s/^say\s+(\S+)\s+(.*)//) {
return unless (&hasFlag("o"));
my ($chan,$msg) = (lc $1, $2);
+
&DEBUG("chan => '$1', msg => '$msg'.");
+ # TODO: add nick destination.
if (&validChan($chan)) {
- &msg($chan, $2);
+ &msg($chan, $msg);
} else {
- &msg($who,"i'm not on \002$1\002, sorry.");
+ &msg($who,"i'm not on \002$chan\002, sorry.");
}
+
+ return;
+ }
+
+ # do.
+ if ($message =~ s/^do\s+(\S+)\s+(.*)//) {
+ return unless (&hasFlag("o"));
+ my ($chan,$msg) = (lc $1, $2);
+
+ &DEBUG("chan => '$1', msg => '$msg'.");
+
+ # TODO: add nick destination.
+ if (&validChan($chan)) {
+ &action($chan, $msg);
+ } else {
+ &msg($who,"i'm not on \002$chan\002, sorry.");
+ }
+
return;
}
return;
}
- ### TODO: fix up $op to support mysql/pgsql/dbm(perl)
+ ### TODO: fix up $op to support mysql/sqlite/pgsql
### TODO: => add db/sql specific function to fix this.
my @list = &searchTable("factoids", "factoid_key",
"factoid_value", $op);
}
&status("jumping servers... $server...");
- &rawout("QUIT :jumping to $server");
+ $conn->quit("jumping to $server");
if (&irc($server,$port) == 0) {
&ircloop();
return;
}
+ # reset.
+ if ($message =~ /^reset$/i) {
+ return unless (&hasFlag("n"));
+
+ &msg($who,"resetting...");
+ my @done;
+ foreach ( keys %channels, keys %chanconf ) {
+ my $c = $_;
+ next if (grep /^\Q$c\E$/i, @done);
+
+ &part($_);
+
+ push(@done, $_);
+ sleep 1;
+ }
+ &DEBUG("before clearircvars");
+ &clearIRCVars();
+ &DEBUG("before joinnextchan");
+ &joinNextChan();
+ &DEBUG("after joinnextchan");
+
+ &status("USER reset $who");
+ &msg($who,"reset complete");
+
+ return;
+ }
+
# rehash.
if ($message =~ /^rehash$/) {
return unless (&hasFlag("n"));
my @chans;
while ($args =~ s/^($mask{chan})\s*//) {
- push(@chans, $1);
+ push(@chans, lc($1));
}
if (!scalar @chans) {
my($what,$val) = split /[\s\t]+/, $args, 2;
### TODO: "cannot set values without +m".
- return unless (&hasFlag("m"));
+ return unless (&hasFlag("n"));
# READ ONLY.
if (defined $what and $what !~ /^[-+]/ and !defined $val and $no_chan) {
my %vals;
foreach (keys %chanconf) {
- my $val = $chanconf{$_}{$what} || "NOT-SET";
+ my $val;
+ if (defined $chanconf{$_}{$what}) {
+ $val = $chanconf{$_}{$what};
+ } else {
+ $val = "NOT-SET";
+ }
$vals{$val}{$_} = 1;
}
foreach (keys %vals) {
- &pSReply(" $what = $_: ".join(' ', keys %{ $vals{$_} } ) );
+ &pSReply(" $what = $_(" . scalar(keys %{$vals{$_}}) . "): ".join(' ', keys %{ $vals{$_} } ) );
}
&pSReply("End of list.");
return;
}
+ ### TODO: move to UserDCC again.
+ if ($cmd eq "chanset" and !defined $what) {
+ &DEBUG("showing channel conf.");
+
+ foreach $chan (@chans) {
+ if ($chan eq '_default') {
+ &pSReply("Default channel settings");
+ } else {
+ &pSReply("chan: $chan (see _default also)");
+ }
+ my @items;
+ my $str = "";
+ foreach (sort keys %{ $chanconf{$chan} }) {
+ my $newstr = join(', ', @items);
+ ### TODO: make length use channel line limit?
+ if (length $newstr > 370) {
+ &pSReply(" $str");
+ @items = ();
+ }
+ $str = $newstr;
+ push(@items, "$_ => $chanconf{$chan}{$_}");
+ }
+ &pSReply(" $str") if (@items);
+ }
+ return;
+ }
+
+ $cache{confvars}{$what} = $val;
+ &rehashConfVars();
+
foreach (@chans) {
&chanSet($cmd, $_, $what, $val);
}
}
if ($message =~ /^(chanunset|\-chan)(\s+(.*))?$/) {
- return unless (&hasFlag("m"));
+ return unless (&hasFlag("n"));
my $args = $3;
my $no_chan = 0;
if ($args =~ s/^(\-)?($mask{chan})\s*//) {
$chan = $2;
$delete = ($1) ? 1 : 0;
- &DEBUG("chan => $chan.");
} else {
&VERB("no chan arg; setting to default.",2);
$chan = "_default";
$chanconf{$_}{$args} = $val;
}
delete $chanconf{_default}{$args};
+ $cache{confvars}{$args} = 0;
+ &rehashConfVars();
return;
}
&DEBUG("delete chanconf{$_}{$args};");
delete $chanconf{$_}{$args};
}
+ $cache{confvars}{$args} = 0;
+ &rehashConfVars();
return;
}
return;
}
+ if ($message =~ /^newpass(\s+(.*))?$/) {
+ my(@args) = split /[\s\t]+/, $2 || '';
+
+ if (scalar @args != 1) {
+ &help("newpass");
+ return;
+ }
+
+ my $u = &getUser($who);
+ my $crypt = &mkcrypt($args[0]);
+
+ &pSReply("Set your passwd to '$crypt'");
+ $users{$u}{PASS} = $crypt;
+
+ $utime_userfile = time();
+ $ucount_userfile++;
+
+ return;
+ }
if ($message =~ /^chpass(\s+(.*))?$/) {
my(@args) = split /[\s\t]+/, $2 || '';
return;
}
- my $u = &getUser($who);
+ my $u = &getUser($args[0]);
+ if (!defined $u) {
+ &pSReply("Internal error, u = NULL.");
+ return;
+ }
- if (scalar @args == 1) { # del pass.
- if (!&IsFlag("m") and $who !~ /^\Q$verifyUser\E$/i) {
- &pSReply("cannto remove passwd of others.");
+ if (scalar @args == 1) {
+ # del pass.
+ if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
+ &pSReply("cannot remove passwd of others.");
return;
}
return;
}
- my $salt = join '',('.','/',0..9,'A'..'Z','a'..'z')[rand 64, rand 64];
- my $crypt = crypt($args[1], $salt);
+ my $crypt = &mkcrypt($args[1]);
&pSReply("Set $u's passwd to '$crypt'");
$users{$u}{PASS} = $crypt;
return;
}
+ my $chflag;
my $user;
- if ($args[0] =~ /^$mask{nick}$/i) { # <nick>
+ if ($args[0] =~ /^$mask{nick}$/i) {
+ # <nick>
$user = &getUser($args[0]);
$chflag = $args[1];
- } else { # <flags>
+ } else {
+ # <flags>
$user = &getUser($who);
&DEBUG("user $who... nope.") unless (defined $user);
$user = &getUser($verifyUser);
}
if (!defined $user) {
- &pSReply("user $user does not exist.");
+ &pSReply("user does not exist.");
return;
}
&DEBUG("who => $who");
&DEBUG("verifyUser => $verifyUser");
- if (!&IsFlag("m") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
&pSReply("cannto change attributes of others.");
return "REPLY";
}
return;
}
- if (!&IsFlag("m") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
&pSReply("cannto change nick of others.");
return "REPLY" if ($who eq "_default");
return;
my ($user,$mask);
if ($args[0] =~ /^$mask{nick}$/i) { # <nick>
- return unless (&hasFlag("m"));
+ return unless (&hasFlag("n"));
$user = &getUser($args[0]);
$mask = $args[1];
} else { # <mask>
- # who or verifyUser. FIXME!!!
+ # FIXME: who or verifyUser. (don't remember why)
$user = &getUser($who);
$mask = $args[0];
}
}
if (!defined $mask) {
- ### FIXME.
- &pSReply("Hostmasks for $user: $users{$user}{HOSTS}");
-
+ &pSReply("Hostmasks for $user: " . join(" ", keys %{$users{$user}{HOSTS}}));
return;
}
- if (!&IsFlag("m") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
&pSReply("cannto change masks of others.");
return;
}
- if ($mask !~ /^$mask{nuh}$/) {
- &pSReply("error: mask ($mask) is not a real hostmask.");
- return;
- }
-
my $count = scalar keys %{ $users{$user}{HOSTS} };
if ($state) { # add.
+ if ($mask !~ /^$mask{nuh}$/) {
+ &pSReply("error: mask ($mask) is not a real hostmask.");
+ return;
+ }
+
if (exists $users{$user}{HOSTS}{$mask}) {
&pSReply("mask $mask already exists.");
return;
}
if ($state == 0) { # delete.
- my $c = join(' ', &banDel($mask) );
+ my @c = &banDel($mask);
- if ($c) {
- &pSReply("Removed $mask from chans: $c");
+ foreach (@c) {
+ &unban($mask, $_);
+ }
+
+ if (@c) {
+ &pSReply("Removed $mask from chans: @c");
} else {
&pSReply("$mask was not found in ban list.");
}
$reason = $1;
}
- if (!&IsFlag("m") and $who !~ /^\Q$verifyUser\E$/i) {
+ if (!&IsFlag("n") and $who !~ /^\Q$verifyUser\E$/i) {
&pSReply("cannto change masks of others.");
return;
}
if ($message =~ /^banlist(\s+(.*))?$/) {
my $arg = $2;
- if (defined $arg and $arg !~ /^$mask_chan$/) {
+ if (defined $arg and $arg !~ /^$mask{chan}$/) {
&pSReply("error: chan $chan is invalid.");
return;
}
&writeUserFile();
&writeChanFile();
+ &pSReply("saved user and chan files");
return;
}
if (!$state) { # delignore.
if ( &ignoreDel($mask) ) {
- &pSReply("ok, deleted X ignores.");
+ &pSReply("ok, deleted ignores for $mask.");
} else {
&pSReply("could not find $mask in ignore list.");
}
# time.
if ($args =~ s/^(\d+)\s*//) {
- $time = $1*60; # ??
+ $time = $1; # time is in minutes
} else {
$time = 0;
}
}
if ( &ignoreAdd($mask, $chan, $time, $comment) > 1) {
- &pSReply("warn: $mask already in ignore list; written over anyway. FIXME");
+ &pSReply("FIXME: $mask already in ignore list; written over anyway.");
} else {
&pSReply("added $mask to ignore list.");
}
if ($str eq "+") {
if (scalar @args != 2) {
- &pSReply(".+host requires hostmask argument.");
+ &pSReply("+user requires hostmask argument.");
return;
}
} elsif (scalar @args != 1) {
return;
}
- if ($state) { # adduser.
+ if ($state) {
+ # adduser.
if (scalar @args == 1) {
$args[1] = &getHostMask($args[0]);
- if (!defined $args[1]) {
- &ERROR("could not get hostmask?");
- return;
- }
+ &pSReply("Attemping to guess $args[0]'s hostmask...");
+
+ # crude hack... crappy Net::IRC
+ $conn->schedule(5, sub {
+ # hopefully this is right.
+ my $nick = (keys %{ $cache{nuhInfo} })[0];
+ if (!defined $nick) {
+ &pSReply("couldn't get nuhinfo... adding user without a hostmask.");
+ &userAdd($nick);
+ return;
+ }
+ my $mask = &makeHostMask( $cache{nuhInfo}{$nick}{NUH} );
+
+ if ( &userAdd($nick, $mask) ) {
+ # success.
+ &pSReply("Added $nick with flags $users{$nick}{FLAGS}");
+ my @hosts = keys %{ $users{$nick}{HOSTS} };
+ &pSReply("hosts: @hosts");
+ }
+ });
+ return;
}
+ &DEBUG("args => @args");
if ( &userAdd(@args) ) { # success.
- &pSReply("Added $args[0]...");
+ &pSReply("Added $args[0] with flags $users{$args[0]}{FLAGS}");
+ my @hosts = keys %{ $users{$args[0]}{HOSTS} };
+ &pSReply("hosts: @hosts");
} else { # failure.
&pSReply("User $args[0] already exists");
if ($message =~ /^sched$/) {
my @list;
my @run;
+
+ my %time;
foreach (keys %sched) {
next unless (exists $sched{$_}{TIME});
+ $time{ $sched{$_}{TIME}-time() }{$_} = 1;
push(@list,$_);
next unless (exists $sched{$_}{RUNNING});
push(@run,$_);
}
- &pSReply( &formListReply(0,"Scheds to run: ", sort @list ) );
+ my @time;
+ foreach (sort { $a <=> $b } keys %time) {
+ my $str = join(", ", sort keys %{ $time{$_} });
+ &DEBUG("time => $_, str => $str");
+ push(@time, "$str (".&Time2String($_).")");
+ }
+
+ &pSReply( &formListReply(0, "Schedulers: ", @time ) );
+ &pSReply( &formListReply(0, "Scheds to run: ", sort @list ) );
&pSReply( &formListReply(0, "Scheds running(should not happen?) ", sort @run ) );
return;
}
+ # quite a cool hack: reply in DCC CHAT.
+ $msgType = "chat" if (exists $dcc{'CHAT'}{$who});
+
+ my $done = 0;
+ $done++ if &parseCmdHook("main", $message);
+ $done++ if &parseCmdHook("extra", $message);
+ $done++ unless (&Modules());
+
+ if ($done) {
+ &DEBUG("running non DCC CHAT command inside DCC CHAT!");
+ return;
+ }
+
return "REPLY";
}
projects / infobot.git / blobdiff