#!/usr/local/bin/perl -w # Original work by Marc Quinton@stna.dgac.fr / quinquin/IRCnet # Rewrite by schuyler/rhizomatic # # ua/rhizomatic 11 Oct 2002 # + General rewrite # + Global friends list added # + use strict # # XChat Perl Programming Docs: # http://xchat.org/xchatdox2.html our $VERSION = "0.10"; # XChat acting buggy - displaying [badly] incorrect @INC. Override: BEGIN { if ($ENV{USER} eq 'jkeroes') { @INC = qw(/usr/local/lib/perl5/5.6.0/sun4-solaris /usr/local/lib/perl5/5.6.0 /usr/local/lib/perl5/site_perl/5.6.0/sun4-solaris /usr/local/lib/perl5/site_perl/5.6.0 /usr/local/lib/perl5/site_perl ); } } use strict; use subs qw/please_note debug_note/; use LWP::Simple; use YAML qw/LoadFile Dump Load/; use Data::Dumper; # Print loading messages use constant VERBOSE => 1; # 1: Print runtime messages # 2: Print above + loaded friends regex table use constant DEBUGGING => 1; # Prepended to all console messages use constant ID => '[Auto-op] '; # Wait this many seconds for someone else to op first. # use constant LAG => 3; our $FRIENDS_URL = 'http://ua.sez.hellyeah.org/perl/friends.yaml'; our $FRIENDS_LOCAL = "$ENV{HOME}/.xchat/friends_local.yaml"; our $FRIENDS_REMOTE = "$ENV{HOME}/.xchat/friends.yaml"; #------------------------------------------------------------ # Main #------------------------------------------------------------ please_note "Mirroring friend list."; my $rc = mirror( $FRIENDS_URL, $FRIENDS_REMOTE ); please_note "Can't mirror $FRIENDS_URL, using old file. HTTP returned: $rc" if $rc != RC_OK && $rc != RC_NOT_MODIFIED; my %AUTO = load_friends() or die "Couldn't find any friends files. Aborting"; please_note "Installing handlers."; IRC::register( "auto-op.pl", $VERSION, "", "" ); IRC::add_message_handler( JOIN => "join_handler" ); IRC::add_message_handler( MODE => "mode_handler" ); please_note "Running!"; #------------------------------------------------------------ # Subs #------------------------------------------------------------ sub please_note { VERBOSE ? IRC::print( "\0037" . ID . "@_\003 \n" ) : '' } sub debug_note { DEBUGGING ? IRC::print( "\0037" . ID . "@_\003 \n" ) : '' } sub mode_handler { my ($line) = @_; my ($chan, $who); # Did someone get opped? return 0 unless ( $chan, $who ) = ( $line =~ /MODE\s+(\S+)\s+\+o\S*\s+(.+)/io ); my $nick = IRC::get_info(1); # Who am I? debug_note "Caught +o on $chan: $who (vs. $nick)"; return 0 unless $who =~ /$nick/i; # Did I get opped? my @auto = list_friends( $chan ); debug_note "Found", scalar(@auto), "friends on $chan"; return 0 unless @auto; # It takes X-Chat a second or so to populate IRC::user_list() # after joining a channel. So wait a second to actually give out ops. # IRC::add_timeout_handler( 1000, "give_ops" ); return 0; } sub give_ops { my $chan = IRC::get_info(2); my @auto = list_friends( $chan ); return 0 unless @auto; my $match = join("|", @auto); my $regexp = qr/^(?:$match)$/i; my $server = IRC::get_info(3); my @users = IRC::user_list( $chan, $server ); debug_note "Found", scalar(@users)/5, "users on $chan/$server"; while (my ($user, $addr, $op, $voice, $colon) = splice(@users, 0, 5)) { next if $op; # User's already got ops. debug_note "Checking if $user!$addr is a friend." if DEBUGGING >= 2; next unless "$user!$addr" =~ $match; please_note "Attempting to op $user on $chan"; IRC::command( "/MODE $chan +o $user" ); } } sub join_handler { my ($line) = @_; my ($nick, $addr, $chan, $user); # IRC::print "inbound_handler() ''$line''\n"; return 0 unless ( $nick, $chan ) = ( $line =~ m/:(.+?\!.+?)\s+JOIN\s+:(.*)/o ); debug_note "Caught JOIN on $chan: $nick" if DEBUGGING >= 2; my @auto = list_friends( $chan ); return 0 unless @auto; for ( @auto ) { ($user) = $nick =~ /($_)/i and last; } return 0 unless $user; debug_note "Matched user $user to $nick on $chan"; $nick =~ s/!.*$//o; debug_note "Attempting to op $nick on $chan"; IRC::command( "/MODE $chan +o $nick" ); return 0; } sub list_friends { my $chan = shift; return map { @$_ } grep( $_, @AUTO{ $chan, '*' } ); } sub load_friends { my ($remote, $local); if ( -r $FRIENDS_REMOTE ) { please_note "Loading remote friends: $FRIENDS_REMOTE"; $remote = LoadFile($FRIENDS_REMOTE) or warn "Can't load $FRIENDS_REMOTE: $!"; } if ( -r $FRIENDS_LOCAL ) { please_note "Loading local friends: $FRIENDS_LOCAL"; $local = LoadFile($FRIENDS_LOCAL); } debug_note(Data::Dumper->Dump([ $remote, $local ], [ qw/remote local/ ])) if DEBUGGING >= 2; # Merge the two lists if ( $local and %$local ) { while ( my ($k, $v) = each %$local ) { unless (ref $v eq "ARRAY") { warn "Bad data. Values must be arrayrefs of Regexen. Skipping '$k'"; next; } push @{ $remote->{$k} }, @{ $local->{$k} }; } } debug_note(Data::Dumper->Dump([ $remote ], [ qw/merged/ ])) if DEBUGGING >= 2; return %$remote; }