#!/usr/bin/perl -w

# This code is Copyright (C) 2000 Nathaniel Smith <njs@uclink4.berkeley.edu>
# This code is licensed under the GNU GPL version 2, or, at your option,
# any later version.

# A nickserv autoresponder for xchat
#   put it in ~/.xchat/, and it'll be loaded automatically.
#
# A quick and dirty hack, but it does what I need it to... and is
# hopefully secure to boot.
#
# Somewhat idiosyncronatic, but here are the commands:
# /register <nick> <password> [nickserv] [server] [msg]
#     The basic command: do it to tell the script that you've registered
#     with a nickserv.  Each argument is a regexp; they refer to your
#     nick (won't respond unless you're using this nick), the password
#     for that nick, the id of the nickserv that requests the password
#     (don't want to let people /msg you and get your password) (in
#     nick!user@host format), the server you are registered on, and the
#     message nickserv sends you that should trigger sending the password.
#
#     Remember, these are all regexps: so if you registered both njs and
#     njs2 on the openprojects network, you'd use something like:
#       /register ^njs2?$ flubber ^NickServ!s@NickServ$ ^(.*\.openprojects\.net|irc\.debian\.org)$ This nickname is registered and protected.
#     Notice how the msg argument swallows up all the stuff at the end.
#
#     The defaults are ^[Nn]ick[Ss]erv!.*@<whatever you put for server>$,
#     current server, and ".*This nick is registered.*".  You probably want
#     to change the server argument at least to something more flexible, and
#     the nickserv one will probably have to be changed as well.
#
#     Only the msg argument can contain spaces.  Remember your ^ and $'s.
#
#     A usage message will be printed if you just type /register.
#
# /unregister <nick> [password] [server]
#     This will delete all entries that match in the fields given.
#     Note that these are regexps -- so you have to write regexps
#     that will match the regexps you put in.  Have fun.
#
#     All changes made through /register or /unregister will be
#     persistent across sessions.
#     
# /lregister [nick] [pass] [server]
#     Lists all matching entries.  Same caveats apply as do to
#     /unregister.

# I wonder if these should get a unique prefix, or we should put a package
# declaration here, or something, to prevent collisions with other scripts
# that may use the same global variable names.
$script = "nickserv";
$version = "1.2";
$debug = 0;
$save_file = "$ENV{HOME}/.xchat/nickserv-registry";
$disable = 0;

IRC::print "\0035:: Loading nickserv autoresponder (v$version)::\003 \n";

# don't let people read our passwords
umask(0077);
if (stat($save_file)) {
    my $perms = (stat($save_file))[2];
    if ($perms & 0077) {
        IRC::print("Bad permissions on $save_file: must be 0700 or better\n");
        IRC::print("nickserv.pl disabled\n");
        $disable = 1;
    }
}

if (!$disable) {
    do "$save_file";
    IRC::register($script, $version, "save_registered_list", "");
    IRC::add_message_handler("NOTICE", "notice_handler");
#  uncomment this line if your nickserv uses /msg to talk to you
#    IRC::add_message_handler("PRIVMSG", "notice_handler");
    IRC::add_command_handler("register", "register_handler");
    IRC::add_command_handler("unregister", "unregister_handler");
    IRC::add_command_handler("lregister", "lregister_handler");
#    IRC::add_command_handler("set_register_debug", "debug_handler");
} else {
    IRC::register($script, $version, "", "");
    foreach ("register", "unregister", "lregister") {
        IRC::add_command_handler($_, "disabled_handler");
    }
}

sub disabled_handler {
    IRC::print("Sorry, that command is disabled.  Fix your problems with the script first (probably printed during start up).\n");
    return 1;
}

sub debug_handler {
    if ($_[0] =~ /off|no/) {
	$debug = 0;
    } else {
	$debug = 1;
    }
    return 1;
}

sub register_handler {
    my $arg = $_[0];
    $arg =~ s/\s+/ /g;

    my ($nick, $pass, $nickserv, $server, $msg) = split(/ /, $arg, 5);

    $server = IRC::get_info(3) unless defined($server);
    $msg = ".*This nick is registered.*" unless defined ($msg);
    $nickserv = "^[Nn]ick[Ss]erv!.*\@$server\$" unless defined ($nickserv);

    if (!defined($nick) || !defined($pass)) {
        IRC::print("Error: need at least a nick and a password\n");
        IRC::print("Try again as: /register <nick> <password> [nickserv] [server] [msg]\n");
        IRC::print("Each will be interpreted as a regexp\n");
        return 1;
    }

    IRC::print("Will respond to $nickserv saying \"$msg\" if you are " .
               "logged into \"$server\" as \"$nick\" with \"/msg <nick> " .
               "identify $pass\"\n");
    push(@$registered, [ $server, $nickserv, $msg, $nick, $pass ]);

    return 1;
}

sub lregister_handler {
    # Warning: this procedure filters by regexps.  So to use it,
    # enter a regexp that will match your regexps.  Sorry.
    
    my $arg = $_[0];
    $arg =~ s/\s+/ /g;
    @_ = split(/ /, $arg);

    my @args = ("nick", "pass", "server");
    foreach my $arg (@args) {
	eval("\$$arg = shift");
    }

    my $num = 0;
    foreach $reg (@$registered) {
	next if ($nick && $reg->[3] !~ /$nick/);
	next if ($pass && $reg->[4] !~ /$pass/);
	next if ($server && $reg->[0] !~ /$server/);

        IRC::print("\n") if $num;
        IRC::print("Nick: $reg->[3]\n" .
  		   "Pass: $reg->[4]\n" .
		   "Server: $reg->[0]\n" .
		   "Nickserv: $reg->[1]\n" .
		   "Msg: $reg->[2]\n");
	$num++;
    }

    if (!$num) {
      IRC::print("Nothing registered\n");
    }

    return 1;
}

sub unregister_handler {
    # Warning: this procedure filters by regexps.  So to use it,
    # enter a regexp that will match your regexps.  Sorry.
    
    my $arg = $_[0];
    $arg =~ s/\s+/ /g;

    my ($nick, $pass, $server) = split(/ /, $arg);
    IRC::print("nick = $nick, pass = $pass, server = $server\n") if $debug;

    if (!defined($nick)) {
        IRC::print("Usage: /unregister <nick> [password] [server]\n");
        IRC::print("each argument is a regexp; all entries which match all of " .
  		   "them will be deleted.\n");
	return 1;
    }
    
    $registered = [ grep
		    { ((!defined($nick) || $_->[3] !~ /$nick/)
		       && (!defined($pass) || $_->[4] !~ /$pass/)
		       && (!defined($server) || $_->[0] !~ /$server/)) }
		    @$registered ];
    
    return 1;
}

sub notice_handler {
    IRC::print("Called with:\n") if $debug;
    foreach (@_) {
        IRC::print("\t" . $_ . "\n") if $debug;
    }
    
    my ($id, undef, undef, $msg) = split(/ /, $_[0], 4);
    # strip leading colons (needed on openprojects.net, at least)
    $id =~ s/^://;
    $msg =~ s/^://;
    ($nick, undef) = split(/!/, $id, 2);
    IRC::print("id = $id, nick = $nick, msg = $msg\n") if $debug;

    foreach my $reg (@$registered) {
        my ($goodserver, $goodid, $goodmsg, $goodnick) = (0, 0, 0, 0);
        if (IRC::get_info(3) =~ /$reg->[0]/) {
            IRC::print("goodserver " . IRC::get_info(3) . "\n" ) if $debug;
            $goodserver = 1;
        }
        if ($id =~ /$reg->[1]/) {
            IRC::print("goodid $id\n") if $debug;
            $goodid = 1;
        }
        if ($msg =~ /$reg->[2]/) {
            IRC::print("goodmsg $msg\n") if $debug;
            $goodmsg = 1;
        }
        if (IRC::get_info(1) =~ /$reg->[3]/) {
            IRC::print("goodnick " . IRC::get_info(1) . "\n") if $debug;
            $goodnick = 1;
        }
        if ($goodserver && $goodid && $goodmsg && $goodnick) {
            IRC::print("Going to send password $reg->[4] to $nick\n") if $debug;
            IRC::command("/msg $nick identify $reg->[4]");
        }
        if (($goodserver && !$goodid && $goodmsg)
	    || ($goodmsg && $goodid && !$goodserver)) {
            IRC::print("\0035:: WARNING: $nick MAY HAVE ATTEMPTED TO SPOOF YOUR PASSWORD ::\003 \n");
        }
    }
    return 0;
}

sub save_registered_list {
    open(REG, ">$save_file");

    my %hash = ( 0 => "server regexp",
		 1 => "nickserv regexp",
		 2 => "message regexp",
		 3 => "nick regexp",
		 4 => "password",
		 );
    
    print REG "\$registered = [\n";
    foreach $reg (@$registered) {
	print REG "\t[\n";
	foreach (0..$#{$reg}) {
	    print REG "\t  \'$reg->[$_]\',\t# $hash{$_}\n";
	}
	print REG "\t],\n";
    }
    print REG "];\n";
    close(REG);
}

1;