wilkowe skrypty dla irssi

Wszystko co chcielibyście wiedzieć o kanale, poznać historię jego powstawania, dowiedzieć się kto nim administruje i jaki jest regulamin, zobaczyć osiągnięcia naszych najlepszych graczy oraz sprawdzić globalny ranking Q-punktów, bądź poczytać kompendium wiedzy o quizach IRC-owych.

Polecenia: IRC, quizbot, statbot, funbot

wilkowe skrypty dla irssi

Postprzez wilk » 23 lutego 2018, 02:54

Może komuś się przyda takie coś. Są to wyodrębnione z mojego starego skryptu i nieco ucywilizowane wybrane polecenia. Wszystkie polecenia mają dodany mały /help.

Do pobrania: skrypty dla irssi, inne: skrypty dla mIRCa, skrypty dla Eggdropa.

privacy.pl (v1.0) - wyświetlenie sobie kanałów, które są widoczne dla innych (czyli bez flag s/p/a).

Kod: Zaznacz cały
########################################
##  Privacy checker by wilk/xorandor  ##
########################################
#
# /privacy
#  Lists joined channels visible to others (no s/p/a flag).
#  Supports multiple networks (appends network tag).
#
#####
#
# v1.0 (20180218)
#  - extracted from my old script and made it public
#

use strict;
use warnings;
use vars qw($VERSION %IRSSI);
use Irssi qw(theme_register command_bind printformat signal_stop servers);

$VERSION = '1.0';
%IRSSI = (
   name      => 'privacy',
   description   => 'Lists joined channels visible to others',
   authors      => 'wilk',
   contact      => 'wilk @ IRCnet',
   license      => 'GNU GPL v2 or any later version',
   changed      => '18.02.2018',
   url         => 'https://scripts.irssi.org'
);

Irssi::theme_register([
   'privacy_list',      'Public channels (%_$0%_): $1',
]);

sub cmd_privacy {
   foreach my $srvr (sort { lc($a->{tag}) cmp lc($b->{tag}) } servers()) {
      my @chans;
      foreach my $chan (sort { lc($a->{name}) cmp lc($b->{name}) } $srvr->channels()) {
         my $modes = (split(/ /, $chan->{mode}))[0] // '';
         next if ($modes =~ /[psa]/);
         push(@chans, $chan->{ownnick}{prefixes} . $chan->{name});
      }
      printformat(MSGLEVEL_CRAP, 'privacy_list', $srvr->{tag}, join(', ', @chans));
   }
}

sub cmd_help {
   my ($cmd, $server, $window) = @_;
   $cmd =~ s/^\s+|\s+$//g;
   if (lc($cmd) eq 'privacy') {
      print CLIENTCRAP;
      print CLIENTCRAP 'PRIVACY';
      print CLIENTCRAP;
      print CLIENTCRAP 'Lists joined channels visible to others via /whois - those without "p"/"s" flag (&#! channels) or "a" flag (&! channels).';
      print CLIENTCRAP;
      signal_stop();
   }
}

command_bind('help',   'cmd_help');
command_bind('privacy',   'cmd_privacy');

sharedusers.pl (v1.0) - wyszukuje użytkowników z którymi dzielimy więcej niż jeden kanał. Można sprawdzać ogólnie (okno statusu) lub dla aktualnie otwartego kanału. Jeśli podamy jako parametr nazwę kanału, to listuje tylko te osoby, z którymi dzielimy oba kanały.

Kod: Zaznacz cały
##########################################
##  Find shared users by wilk/xorandor  ##
##########################################
#
# /sharedusers [channel]
#  Finds shared users (joined to more than one channel with our
#   presence) globally (status) or against active channel. Provide
#   additional channel name to make cross-match between both of them
#   (users present on active channel and the other one).
#  Supports multiple networks (appends network tag).
#
#####
#
# v1.0 (20180218)
#  - extracted from my old script and made it public
#

use strict;
use warnings;
use vars qw($VERSION %IRSSI);
use Irssi qw(theme_register command_bind printformat signal_stop channels);

$VERSION = '1.0';
%IRSSI = (
   name      => 'sharedusers',
   description   => 'Finds shared users globally or from active channel',
   authors      => 'wilk',
   contact      => 'wilk @ IRCnet',
   license      => 'GNU GPL v2 or any later version',
   changed      => '18.02.2018',
   url         => 'https://scripts.irssi.org'
);

Irssi::theme_register([
   'sharedusers_user',         'Shared user: $0 ($1)',
   'sharedusers_count',      'Total shared users: $0',
   'sharedusers_no_shared',   'No shared users found',
]);

sub cmd_sharedusers {
   my ($args, $server, $channel) = @_;
   $args =~ s/^\s+|\s+$//g;
   my $withchan = (split(/ /, lc $args))[0] // '';
   my $global = 1;
   my %nicks;
   if ($channel && ($channel->{type} eq 'CHANNEL')) {
      $global = 0;
      %nicks = map { lc($_->{nick}) => '' } $channel->nicks();
   }
   my %shared;
   foreach my $chan (channels()) {
      foreach my $user ($chan->nicks()) {
         if (($global || exists($nicks{lc $user->{nick}})) && ($user->{nick} ne $chan->{server}{nick})) {
            push(@{$shared{$user->{nick}}}, $chan->{name} . ((lc($chan->{server}{tag}) ne lc($server->{tag})) ? ':' . $chan->{server}{tag} : ''));
         }
      }
   }
   my @users;
   my $shared = 0;
   foreach my $nick (sort { lc($a) cmp lc($b) } keys %shared) {
      if (@{$shared{$nick}} > 1) {
         if (($withchan eq '') || (grep { lc($_) eq lc($withchan) } @{$shared{$nick}})) {
            $shared++;
            printformat(MSGLEVEL_CRAP, 'sharedusers_user', $nick, join(', ', @{$shared{$nick}}));
         }
      }
   }
   if ($shared) {
      printformat(MSGLEVEL_CRAP, 'sharedusers_count', $shared);
   } else {
      printformat(MSGLEVEL_CRAP, 'sharedusers_no_shared');
   }
}

sub cmd_help {
   my ($cmd, $server, $window) = @_;
   $cmd =~ s/^\s+|\s+$//g;
   if (lc($cmd) eq 'sharedusers') {
      print CLIENTCRAP;
      print CLIENTCRAP 'SHAREDUSERS [channel]';
      print CLIENTCRAP;
      print CLIENTCRAP 'Finds shared users (joined to more than one channel with our presence) globally (status) or against active channel.';
      print CLIENTCRAP 'Provide additional channel name to make cross-match between both of them (users present on active channel and the other one).';
      print CLIENTCRAP;
      signal_stop();
   }
}

command_bind('help',      'cmd_help');
command_bind('sharedusers',   'cmd_sharedusers');

matchusers.pl (v1.0) - wyszukiwanie użytkowników pasujących do podanego wzorca. Można wyszukiwać według nick!ident@host (brak parametru lub "-a"), nicka ("-n"), identa ("-i"), hosta ("-h") lub nazwy użytkownika tzw. "real name" ("-r" - nie jest włączone do domyślnego szukania). Zwracana jest lista nicków, ale jeśli mają się pojawić pełne hosty, to podajemy parametr "-f". Wyszukiwanie następuje ogólnie (okno statusu) lub dla otwartego kanału.

Kod: Zaznacz cały
####################################
##  User search by wilk/xorandor  ##
####################################
#
# /matchusers [-a/n/i/h/r/f] <pattern> [channel]
#  Search for known users matching a pattern from all channels (status)
#   or from active channel. You may also give channel name to search
#   only there.
#  Supports multiple networks (appends network tag).
#
#  Options:
#   -a = match against nick!ident@host (default)
#   -n = match against nicks
#   -i = match against idents
#   -h = match against hosts
#   -r = match against real names (excluded from default search)
#   -f = display full hostname
#
#  Wildcards:
#   * - zero or more characters
#   ? - one character
#   % - one digit
#   & - one alphabetic character
#
#####
#
# v1.0 (20180218)
#  - extracted from my old script and made it public
#

use strict;
use warnings;
use vars qw($VERSION %IRSSI);
use Irssi qw(theme_register command_bind printformat signal_stop channels);

$VERSION = '1.0';
%IRSSI = (
   name      => 'matchusers',
   description   => 'Search for users matching criteria',
   authors      => 'wilk',
   contact      => 'wilk @ IRCnet',
   license      => 'GNU GPL v2 or any later version',
   changed      => '18.02.2018',
   url         => 'https://scripts.irssi.org'
);

Irssi::theme_register([
   'matchusers_nicks',         'Matches (%_$0%_): $1',
   'matchusers_count',         'Total matches: $0',
   'matchusers_no_matches',   'No matches found for $0',
   'matchusers_no_channel',   'No such channel is joined',
   'matchusers_usage',         'Usage: /matchusers [-a/n/i/h/r/f] <pattern> [channel]',
]);

sub cmd_matchusers {
   my ($args, $server, $channel) = @_;
   $args =~ s/^\s+|\s+$//g;
   printformat(MSGLEVEL_CRAP, 'matchusers_usage'), return if ($args eq '');
   my ($id, $matchnick, $matchident, $matchhost, $matchname, $fullhost) = (0) x 7;
   my $matchuser = 1;
   my @args = split(/ /, $args);
   if (grep { $_ eq '-f' } @args) { $fullhost = 1; $id++; }
   if (grep { $_ eq '-n' } @args) { $matchnick = 1; $matchuser = 0; $id++; }
   if (grep { $_ eq '-i' } @args) { $matchident = 1; $matchuser = 0; $id++; }
   if (grep { $_ eq '-h' } @args) { $matchhost = 1; $matchuser = 0; $id++; }
   if (grep { $_ eq '-r' } @args) { $matchname = 1; $matchuser = 0; $id++; }
   if (grep { $_ eq '-a' } @args) { $matchuser = 1; $id++; }
   my $re_pattern = my $pattern = lc $args[$id];
   for ($re_pattern) {
      s/\\/\\\\/g; # must be first
      s/\./\\./g;
      s/\[/\\[/g; s/\]/\\]/g;
      s/\{/\\{/g; s/\}/\\}/g;
      s/\^/\\^/g;
      s/\|/\\|/g;
      s/\*/.*/g;
      s/\?/./g;
      s/\%/\\d/g;
      s/\&/\[a-zA-Z\]/g;
   }
   $re_pattern = "^$re_pattern\$";
   my $forchan = $args[$id + 1] // '';
   my $chan = ($forchan ne '') ? $server->channel_find($forchan) : undef;
   my @channels;
   if (defined $chan) {
      push(@channels, $chan);
   } elsif ($forchan ne '') {
      printformat(MSGLEVEL_CRAP, 'matchusers_no_channel');
      return;
   } elsif ($channel && ($channel->{type} eq 'CHANNEL')) {
      push(@channels, $channel);
   } else {
      @channels = channels();
   }
   my %users;
   foreach my $chan (@channels) {
      foreach my $user ($chan->nicks()) {
         my $nick = $user->{nick};
         my $addr = $user->{host};
         my $name = $user->{realname};
         $name =~ s/\002|\003(?:\d{1,2}(?:,\d{1,2})?)?|\017|\026|\037|\035//g;   # remove formatting
         $name = substr($name, 5) if (($chan->{server}{tag} =~ /^ircnet$/i) && (length($name) > 5)); # ircnet adds SID before real name
         my ($ident, $host) = split(/@/, $addr);
         my $data = ($fullhost ? "$nick\!$addr" : $nick);
         $data .= ':' . $chan->{server}{tag} if (lc($chan->{server}{tag}) ne lc($server->{tag}));
         $users{$data}++ if ($matchuser && ("$nick\!$addr" =~ /$re_pattern/i));
         $users{$data}++ if ($matchnick && ($nick =~ /$re_pattern/i));
         $users{$data}++ if ($matchident && ($ident =~ /$re_pattern/i));
         $users{$data}++ if ($matchhost && ($host =~ /$re_pattern/i));
         $users{$data}++ if ($matchname && ($name =~ /$re_pattern/i));
      }
   }
   if (scalar keys %users) {
      printformat(MSGLEVEL_CRAP, 'matchusers_nicks', $pattern, join(', ', sort { lc($a) cmp lc($b) } keys %users));
      printformat(MSGLEVEL_CRAP, 'matchusers_count', scalar(keys %users));
   } else {
      printformat(MSGLEVEL_CRAP, 'matchusers_no_matches', $pattern);
   }
}

sub cmd_help {
   my ($cmd, $server, $window) = @_;
   $cmd =~ s/^\s+|\s+$//g;
   if (lc($cmd) eq 'matchusers') {
      print CLIENTCRAP;
      print CLIENTCRAP 'MATCHUSERS [-a/n/i/h/r/f] <pattern> [channel]';
      print CLIENTCRAP;
      print CLIENTCRAP '   -a - match against nick!ident@host (default)';
      print CLIENTCRAP '   -n - match against nicks';
      print CLIENTCRAP '   -i - match against idents';
      print CLIENTCRAP '   -h - match against hosts';
      print CLIENTCRAP '   -r - match against real names (excluded from default search, use "-a -r")';
      print CLIENTCRAP '   -f - display full hostname';
      print CLIENTCRAP;
      print CLIENTCRAP 'Search for known users matching a pattern from all channels (status) or from active channel. You may also give channel name to search only there.';
      print CLIENTCRAP;
      print CLIENTCRAP 'Wildcards: * (zero or more characters), ? (one character), % (one digit), & (one alphabetic character)';
      print CLIENTCRAP;
      signal_stop();
   }
}

command_bind('help',      'cmd_help');
command_bind('matchusers',   'cmd_matchusers');

findclones.pl (v1.0) - wyszukiwarka klonów, czyli osób współdzielących ten sam ident czy host. Domyślnie wyszukuje wszystkie rodzaje klonów (brak parametru lub "-a"), lecz możemy szukać tylko hostów ("-h"), identów ("-i") oraz identów + hostów ("-u"). Dostępne jest także wyszukiwanie proxy (takie jak w Psotnicu) poprzez "-p" - jest ono wyłączone z podstawowego szukania i polega na wyodrębnieniu userów, którzy mają jakiś prefiks przed identem i odpowiednim pogrupowaniu ich adresów (*.domena.tld, X.X.X.*, X:X:X:X:*). Jeśli podamy parametr "-l", to wszystkie identy zostaną potraktowane jako "*ident".

Kod: Zaznacz cały
#######################################
##  Clone detector by wilk/xorandor  ##
#######################################
#
# /findclones [-a/h/i/p/u/l] [channel]
#  Detects ident, host, proxy and ident@host clones on provided
#   channel, otherwise seeks them globally (status) or on active
#   channel.
#  Supports multiple networks (appends network tag).
#
#  Options:
#   -a = find all below types of clones (default)
#   -h = find host clones (*!*@host)
#   -i = find ident clones (*!ident@*)
#   -p = find proxy clones (excluded from default search)
#   -u = find user clones (*!ident@host)
#   -l = loose idents (drops prefixes and uses *ident)
#
#####
#
# v1.0 (20180219)
#  - extracted from my old script and made it public
#

use strict;
use warnings;
use vars qw($VERSION %IRSSI);
use Irssi qw(theme_register command_bind printformat signal_stop channels);

$VERSION = '1.0';
%IRSSI = (
   name      => 'findclones',
   description   => 'Detects ident, host, proxy, ident@host clones',
   authors      => 'wilk',
   contact      => 'wilk @ IRCnet',
   license      => 'GNU GPL v2 or any later version',
   changed      => '19.02.2018',
   url         => 'https://scripts.irssi.org'
);

Irssi::theme_register([
   'findclones_host',         'Host clones: $0',
   'findclones_ident',         'Ident clones: $0',
   'findclones_proxy',         'Proxy clones: $0',
   'findclones_user',         'User clones: $0',
   'findclones_count',         'Total clones: $0',
   'findclones_no_clones',      'No clones detected',
   'findclones_no_channel',   'No such channel is joined',
]);

sub cmd_findclones {
   my ($args, $server, $channel) = @_;
   $args =~ s/^\s+|\s+$//g;
   my ($id, $looseidents, $hostclones, $identclones, $proxyclones, $userclones) = (0) x 6;
   my $showall = 1;
   my @args = split(/ /, lc $args);
   if (grep { $_ eq '-l' } @args) { $looseidents = 1; $id++; }
   if (grep { $_ eq '-h' } @args) { $hostclones = 1; $showall = 0; $id++; }
   if (grep { $_ eq '-i' } @args) { $identclones = 1; $showall = 0; $id++; }
   if (grep { $_ eq '-p' } @args) { $proxyclones = 1; $showall = 0; $id++; }
   if (grep { $_ eq '-u' } @args) { $userclones = 1; $showall = 0; $id++; }
   if (grep { $_ eq '-a' } @args) { $showall = 1; $id++; }
   my $forchan = $args[$id] // '';
   my $chan = ($forchan ne '') ? $server->channel_find($forchan) : undef;
   my @channels;
   if (defined $chan) {
      push(@channels, $chan);
   } elsif ($forchan ne '') {
      printformat(MSGLEVEL_CRAP, 'findclones_no_channel');
      return;
   } elsif ($channel && ($channel->{type} eq 'CHANNEL')) {
      push(@channels, $channel);
   } else {
      @channels = channels();
   }
   my (%hclones, %iclones, %uclones, %pclones);
   foreach my $chan (@channels) {
      foreach my $user ($chan->nicks()) {
         my $nick = $user->{nick};
         my ($ident, $host) = split(/@/, $user->{host});
         my $proxy = ($ident =~/^[\^~+=\-]/) ? '*!*@' : ''; # '*!' . $ident . '@';
         #   = full UNIX      + = rest UNIX
         # ^ = full OTHER   = = rest OTHER
         # ~ = full none      - = rest none
         if ($proxy ne '') {
            if ($host =~ /^((\d+\.){3})\d+$/) {
               $proxy .= $1 . '*'; # XX.XX.XX.*
            } elsif ($host =~ /^((?:[0-9a-f]+:){4})(?:[0-9a-f]+:){3}[0-9a-f]+$/i) {
               $proxy .= $1 . '*'; # XXXX:XXXX:XXXX:XXXX:*
            #} elsif ($host =~ /.+?(\.[^.]+?\.[^.]+?)$/) {
            } elsif ($host =~ /^[^.]+?(\.[^.]+?\..+)$/) {
               $proxy .= '*' . $1; # *.domain.tld
            } else {
               $proxy = '';
            }
         }
         if ($looseidents) {
            $ident =~ s/^[\^~+=\-]//;
            $ident = '*' . $ident;
         }
         $nick .= (lc($chan->{server}{tag}) ne lc($server->{tag})) ? ':' . $chan->{server}{tag} : '';
         push(@{$pclones{$proxy}}, $nick) if ($proxyclones && ($proxy ne ''));
         push(@{$hclones{'*!*@' . $host}}, $nick) if ($hostclones || $showall);
         push(@{$iclones{'*!' . $ident . '@*'}}, $nick) if ($identclones || $showall);
         push(@{$uclones{'*!' . $ident . '@' . $host}}, $nick) if ($userclones || $showall);
      }
   }
   my $clones = 0;
   $clones += print_clones('findclones_host', \%hclones);
   $clones += print_clones('findclones_ident', \%iclones);
   $clones += print_clones('findclones_proxy', \%pclones);
   $clones += print_clones('findclones_user', \%uclones);
   printformat(MSGLEVEL_CRAP, 'findclones_no_clones') if (!$clones);
}

sub print_clones {
   my ($format, $clones) = @_;
   my $count = 0;
   foreach my $clone (sort { lc($a) cmp lc($b) } keys %$clones) {
      if (@{$$clones{$clone}} > 1) {
         my @nicks = sort { lc($a) cmp lc($b) } keys %{ { map { $_ => 1 } @{$$clones{$clone}} } };
         if (@nicks > 1) {
            printformat(MSGLEVEL_CRAP, $format, $clone . ' (' . join(', ', @nicks) . ')');
            $count++;
         }
      }
   }
   return $count;
}

sub cmd_help {
   my ($cmd, $server, $window) = @_;
   $cmd =~ s/^\s+|\s+$//g;
   if (lc($cmd) eq 'findclones') {
      print CLIENTCRAP;
      print CLIENTCRAP 'FINDCLONES [-a/h/i/p/u/l] [channel]';
      print CLIENTCRAP;
      print CLIENTCRAP '   -a = find all below types of clones (default)';
      print CLIENTCRAP '   -h = find host clones (*!*@host)';
      print CLIENTCRAP '   -i = find ident clones (*!ident@*)';
      print CLIENTCRAP '   -p = find proxy clones (excluded from default search, use "-a -p")';
      print CLIENTCRAP '   -u = find user clones (*!ident@host)';
      print CLIENTCRAP '   -l = loose idents (drops prefixes and uses "*ident"; for -i and -u)';
      print CLIENTCRAP;
      print CLIENTCRAP 'Detects ident, host, proxy and ident@host clones on provided channel, otherwise seeks them globally (status) or on active channel.';
      print CLIENTCRAP;
      print CLIENTCRAP 'Connection is considered as a proxy for identless users. Then ident is dropped and host is reduced: IPv4 by last octet (X.X.X.* = /24), hosts by first segment (*.domain.tld), IPv6 by last four hextets (X:X:X:X:* = /64). This is based on Psotnic bot behaviour.';
      print CLIENTCRAP;
      signal_stop();
   }
}

command_bind('help',      'cmd_help');
command_bind('findclones',   'cmd_findclones');

callnicks.pl (v1.0) - "wołarka" ludzi plus wyświetlenie dodatkowego komunikatu.

Kod: Zaznacz cały
#############################################
##  Channel announcement by wilk/xorandor  ##
#############################################
#
# /callnicks [message]
#  Grabs all channel nicks and sends them onto channel (hilight). Can
#   send additional message as an action.
#
#####
#
# v1.0 (20180219)
#  - extracted from my old script and made it public
#

use strict;
use warnings;
use vars qw($VERSION %IRSSI);
use Irssi qw(theme_register command_bind printformat signal_stop settings_add_str settings_get_str);

$VERSION = '1.0';
%IRSSI = (
   name      => 'callnicks',
   description   => 'Hilights all nicks on channel and sends a message',
   authors      => 'wilk',
   contact      => 'wilk @ IRCnet',
   license      => 'GNU GPL v2 or any later version',
   changed      => '19.02.2018',
   url         => 'https://scripts.irssi.org'
);

Irssi::theme_register([
   'callnicks_error',   'Not connected to server or not on channel',
]);

sub cmd_callnicks {
   my ($text, $server, $channel) = @_;
   printformat(MSGLEVEL_CRAP, 'callnicks_error'), return if (!$server || !$server->{connected} || !$channel || ($channel->{type} ne 'CHANNEL'));
   my @ignored = split(/ /, lc settings_get_str('callnicks_ignore'));
   my @nicks;
   foreach my $user (sort { lc($a->{nick}) cmp lc($b->{nick}) } $channel->nicks()) {
      my $nick = $user->{nick};
      next if (grep { $_ eq lc($nick) } @ignored);
      next if (lc($nick) eq lc($server->{nick}));
      push(@nicks, $nick);
   }
   my $list = join(' ', @nicks);
   $server->command("msg $channel->{name} $list") if ($list ne '');
   $server->command("action $channel->{name} $text") if ($text ne '');
}

sub cmd_help {
   my ($cmd, $server, $window) = @_;
   $cmd =~ s/^\s+|\s+$//g;
   if (lc($cmd) eq 'callnicks') {
      print CLIENTCRAP;
      print CLIENTCRAP 'CALLNICKS [message]';
      print CLIENTCRAP;
      print CLIENTCRAP 'Grabs all channel nicks and sends them onto channel (hilight). Can send additional message as an action. Channel announcement / call to action.';
      print CLIENTCRAP;
      signal_stop();
   }
}

command_bind('help',      'cmd_help');
command_bind('callnicks',   'cmd_callnicks');

settings_add_str($IRSSI{'name'}, 'callnicks_ignore', '');

cidr.pl (v1.0) - kalkulator CIDR <-> IP+maska <-> zakres adresów IP

Kod: Zaznacz cały
########################################
##  CIDR calculator by wilk/xorandor  ##
########################################
#
# /cidr <ip>/<bits>
# /cidr <ip>/<mask>
# /cidr <ip> <ip>
#  Converts CIDR and IP with mask to IP range, fits IP range to CIDR.
#
#####
#
# v1.0 (20180219)
#  - extracted from my old script and made it public
#
#####
#
# todo: ipv6 support
#

use strict;
use warnings;
use vars qw($VERSION %IRSSI);
use Irssi qw(theme_register command_bind printformat signal_stop);

$VERSION = '1.0';
%IRSSI = (
   name      => 'cidr',
   description   => 'Converts between CIDR, IP with mask and IP range',
   authors      => 'wilk',
   contact      => 'wilk @ IRCnet',
   license      => 'GNU GPL v2 or any later version',
   changed      => '19.02.2018',
   url         => 'https://scripts.irssi.org'
);

Irssi::theme_register([
   'cidr_to_range',      '$0 -> %_$1 - $2%_ = $3/$4',
   'cidr_to_range_circa',   '$0 -> %_$1 - $2%_ ~ $3/$4 = $5 - $6',
   'cidr_to_cidr',         '$0 - $1 -> %_$2/$3%_ = $4/$5',
   'cidr_to_cidr_circa',   '$0 - $1 ~> %_$2/$3%_ = $4 - $5 = $6/$7',
   'cidr_invalid_ip',      'Invalid IP',
   'cidr_invalid_bits',   'Invalid CIDR bits',
   'cidr_invalid_mask',   'Invalid IP mask',
]);

sub cmd_cidr {
   my ($arg1, $arg2, $rest) = split(/ /, shift);
   $arg2 = $rest if (defined($arg2) && ($arg2 eq '-')); # case: /cidr ip1 - ip2 (optional "-")
   if (index($arg1, '-') != -1) {
      ($arg1, $arg2) = split(/\-/, $arg1); # case: /cidr ip1-ip2
   }
   printformat(MSGLEVEL_CRAP, 'cidr_invalid_ip'), return if (!defined($arg1) || ($arg1 eq ''));
   if (index($arg1, '/') != -1) { # /cidr ip/bits OR /cidr ip/mask
      my ($ip, $bits) = split(/\//, $arg1);
      printformat(MSGLEVEL_CRAP, 'cidr_invalid_ip'), return if (!validip($ip));
      if ($bits =~ /^\d+$/) { # /cidr ip/bits
         printformat(MSGLEVEL_CRAP, 'cidr_invalid_bits'), return if (($bits < 0) || ($bits > 32));
         my ($ip_l, $ip_h, $mask) = cidr2range($ip, $bits);
         printformat(MSGLEVEL_CRAP, 'cidr_to_range', $arg1, $ip_l, $ip_h, $ip, $mask);
      } else { # /cidr ip/mask
         my $mask = $bits;
         printformat(MSGLEVEL_CRAP, 'cidr_invalid_mask'), return if (!validip($mask));
         my ($ip_l, $ip_h, $bits, $long_ip_l, $long_ip_h) = mask2range($ip, $mask);
         my ($ip2_l, $ip2_h, undef, $long_ip2_l, $long_ip2_h) = cidr2range($ip, $bits);
         if (($long_ip_l == $long_ip2_l) && ($long_ip_h == $long_ip2_h)) {
            printformat(MSGLEVEL_CRAP, 'cidr_to_range', $arg1, $ip_l, $ip_h, $ip_l, $bits);
         } else {
            printformat(MSGLEVEL_CRAP, 'cidr_to_range_circa', $arg1, $ip_l, $ip_h, $ip_l, $bits, $ip2_l, $ip2_h);
         }
      }
   } else { # /cidr ip1 ip2
      my ($ip1, $ip2) = ($arg1, $arg2);
      printformat(MSGLEVEL_CRAP, 'cidr_invalid_ip'), return if (!validip($ip1) || !validip($ip2));
      my (undef, $bits, $long_ip_l, $long_ip_h) = range2cidr($ip1, $ip2);
      my ($ip2_l, $ip2_h, $mask, $long_ip2_l, $long_ip2_h) = cidr2range($ip1, $bits);
      if (($long_ip_l == $long_ip2_l) && ($long_ip_h == $long_ip2_h)) {
         printformat(MSGLEVEL_CRAP, 'cidr_to_cidr', $ip1, $ip2, $ip2_l, $bits, $ip2_l, $mask);
      } else {
         printformat(MSGLEVEL_CRAP, 'cidr_to_cidr_circa', $ip1, $ip2, $ip2_l, $bits, $ip2_l, $ip2_h, $ip2_l, $mask);
      }
   }
}

sub validip {
   my $ip = shift;
   return 0 if (!defined($ip) || ($ip eq ''));
   if (index($ip, ':') != -1) {
      return 0; # ipv6 - todo
      #return 0 if (split(/::/, $ip) > 2);
      #my @hextets = split(/:/, $ip);
      #return 0 if (@hextets > 8);
      # todo: expand ::
      #return 0 if (@hextets != 8);
      #foreach my $hextet (@hextets) {
      #   return 0 if ((substr($hextet, 0, 1) eq '0') && (length($hextet) > 1));
      #   return 0 if ($hextet =~ /[^0-9a-f]/);
      #}
   } else {
      my @octets = split(/\./, $ip);
      return 0 if (@octets != 4);
      return 0 if (grep { ($_ !~ /^\d+$/) || ($_ > 255) || ($_ < 0) } @octets);
   }
   return 1;
}

sub longip {
   my $ip = shift;
   return -1 if (!defined($ip) || ($ip eq ''));
   return -1 if (index($ip, ':') != -1); # nope, no ipv6
   my @octets = split(/\./, $ip);
   if (@octets == 1) {
      return -1 if ($ip !~ /^\d+$/);
      my $hip = sprintf('%08x', $ip);
      return sprintf('%d.%d.%d.%d', hex(substr($hip, 0, 2)), hex(substr($hip, 2, 2)), hex(substr($hip, 4, 2)), hex(substr($hip, 6, 2)));
      # return inet_ntoa(pack('N*', $ip));
   } elsif (validip($ip)) {
      return (((($octets[0] * 256) + $octets[1]) * 256 + $octets[2]) * 256 + $octets[3]);
      # return unpack('l*', pack('l*', unpack('N*', inet_aton($ip))));
   } else {
      return -1;
   }
}

sub cidr2range {
   my ($ip, $bits) = @_;
   my $long_mask = (0xffffffff << (32 - $bits)) & 0xffffffff;
   my $long_ip_l = longip($ip) & $long_mask;
   my $long_ip_h = $long_ip_l | (~$long_mask & 0xffffffff);
   return (longip($long_ip_l), longip($long_ip_h), longip($long_mask), $long_ip_l, $long_ip_h);
}

sub mask2range {
   my ($ip, $mask) = @_;
   my $long_ip_l = longip($ip) & longip($mask);
   my $long_ip_h = $long_ip_l | (~longip($mask) & 0xffffffff);
   my $diff = $long_ip_h - $long_ip_l;
   my $bits = 0;
   while ($diff > 0) {
      $bits++;
      $diff >>= 1;
   }
   return (longip($long_ip_l), longip($long_ip_h), 32 - $bits, $long_ip_l, $long_ip_h);
}

sub range2cidr {
   my ($ip_l, $ip_h) = @_;
   my ($long_ip_l, $long_ip_h) = (longip($ip_l), longip($ip_h));
   my ($tlipl, $tliph) = ($long_ip_l, $long_ip_h);
   my $bits = 0;
   while (($tlipl & 0x80000000) == ($tliph & 0x80000000)) {
      $bits++;
      last if ($bits == 32);
      $tlipl <<= 1;   $tliph <<= 1;
   }
   return ($ip_l, $bits, $long_ip_l, $long_ip_h);
}

sub cmd_help {
   my ($cmd, $server, $window) = @_;
   $cmd =~ s/^\s+|\s+$//g;
   if (lc($cmd) eq 'cidr') {
      print CLIENTCRAP;
      print CLIENTCRAP 'CIDR <ip>/<bits>';
      print CLIENTCRAP 'CIDR <ip>/<mask>';
      print CLIENTCRAP 'CIDR <ip> <ip>';
      print CLIENTCRAP;
      print CLIENTCRAP 'Converts CIDR and IP with mask to IP range, fits IP range to CIDR.';
      print CLIENTCRAP;
      signal_stop();
   }
}

command_bind('help',   'cmd_help');
command_bind('cidr',   'cmd_cidr');
Ostatnio edytowano 28 lutego 2018, 22:37 przez wilk, łącznie edytowano 4 razy
Powód: aktualizacja skryptów
Avatar użytkownika
wilk (autor wątku)
Operator
Operator
Ascendant
Ascendant
 
Posty: 1693
Dołączył(a): 30 lipca 2005, 16:32
Lokalizacja: #QuizPL @ IRCnet
Płeć: Mężczyzna
Pytań w bazie: 12543
Lubię quizy: klasyczne (np. Dizzy)

Powrót do O #QuizPL

Kto przegląda forum

Użytkownicy przeglądający ten dział: Bing i 0 gości

cron