398 lines
11 KiB
Perl
398 lines
11 KiB
Perl
#!/usr/bin/perl
|
|
#
|
|
# NOTE This script uses parts of the following 3 scripts, with modifications,
|
|
# and all their relevant licenses apply:
|
|
#
|
|
# name => 'urlgrab',
|
|
# authors => 'David Leadbeater',
|
|
# contact => 'dgl@dgl.cx',
|
|
# license => 'GNU GPLv2 or later',
|
|
#
|
|
# name => "HiliteUrl",
|
|
# authors => "Stefan Heinemann",
|
|
# contact => "stefan.heinemann\@codedump.ch",
|
|
# license => "GPL",
|
|
#
|
|
# name => "OpenURL",
|
|
# authors => "Stefan 'tommie' Tomanek",
|
|
# contact => "stefan\@pico.ruhr.de",
|
|
# license => "GPLv2",
|
|
#
|
|
# Settings:
|
|
#
|
|
# url_cmd
|
|
# Irssi command to execute to process URLs. %s is replaced by URL.
|
|
# Default: ^exec xdg-open '%s'
|
|
#
|
|
# colour_urls
|
|
# whether to colour URLs or not.
|
|
# Default: 1
|
|
#
|
|
# url_colour
|
|
#
|
|
# mirc colour, from:
|
|
#
|
|
# 0 white
|
|
# 1 black
|
|
# 2 blue
|
|
# 3 green
|
|
# 4 light red
|
|
# 5 red
|
|
# 6 magenta
|
|
# 7 orange
|
|
# 8 yellow orange
|
|
# 9 light green
|
|
# 10 cyan
|
|
# 11 light cyan
|
|
# 12 light blue
|
|
# 13 light magenta
|
|
# 14 gray
|
|
# 15 light gray
|
|
#
|
|
# Default: 3
|
|
#
|
|
# url_number_colour
|
|
# URL number colour as above.
|
|
# Default: 12
|
|
#
|
|
# max_urls
|
|
# Number at which URLs cycle back to 1.
|
|
# Default: 50
|
|
#
|
|
# Commands:
|
|
#
|
|
# /url <N> <#channel|refnum> Open a URL N using url_cmd. N<1: count
|
|
# back from end of log. Without N, opens
|
|
# last in current buffer or <#channel>.
|
|
#
|
|
# /list_urls <N> <#channel|refnum> Print last N URLs in log.
|
|
#
|
|
# /clear_urls Reset URL list in mem, but not log.
|
|
#
|
|
# refnum is the window number.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Irssi;
|
|
use vars qw($VERSION %IRSSI);
|
|
|
|
$VERSION = "1.0.0";
|
|
%IRSSI = (
|
|
authors => "dive",
|
|
contact => "dave\@tty1.uk",
|
|
name => "urlmachine2",
|
|
changed => "$VERSION",
|
|
commands => "url, list_urls, clear_urls",
|
|
description => "Logs and hilights URLs. Adds /url command to open them.",
|
|
license => "GPL, GNU GPLv2 or later, and BSD. See comments.",
|
|
url => "http://tty1.uk",
|
|
);
|
|
|
|
sub init {
|
|
Irssi::settings_add_str( "urlmachine", "url_cmd", "/^exec xdg-open '%s'" );
|
|
Irssi::settings_add_int( "urlmachine", "url_colour", "12" );
|
|
Irssi::settings_add_int( "urlmachine", "url_number_colour", "9" );
|
|
Irssi::settings_add_int( "urlmachine", "max_urls", 50 );
|
|
Irssi::settings_add_bool( "urlmachine", "colour_urls", 1 );
|
|
Irssi::settings_add_bool( "urlmachine", "debug_urls", 0 );
|
|
|
|
Irssi::command_bind( "url", "url_command" );
|
|
Irssi::command_bind( "list_urls", "list_urls" );
|
|
Irssi::command_bind( "clear_urls", "clear_urls" );
|
|
|
|
Irssi::signal_add_first( "message irc action", "url_public" );
|
|
Irssi::signal_add_first( "message irc own_action", 'hilite_urls' );
|
|
Irssi::signal_add_first( "message irc notice", "url_public" );
|
|
Irssi::signal_add_first( "message irc own_notice", 'hilite_urls' );
|
|
Irssi::signal_add_first( "message private", "url_private" );
|
|
Irssi::signal_add_first( "message own_private", 'hilite_urls' );
|
|
Irssi::signal_add_first( "message public", "url_public" );
|
|
Irssi::signal_add_first( "message own_public", 'hilite_urls' );
|
|
Irssi::signal_add_first( "channel topic changed", "hilite_topic" );
|
|
# Irssi::signal_add( "message topic", "hilite_topic" );
|
|
}
|
|
|
|
init();
|
|
my @urls;
|
|
my $lasturl = "";
|
|
|
|
# All protocols listed in https://www.ietf.org/rfc/rfc1738.txt + https
|
|
# It's far simpler to disallow unsafe characters than look for legitimate ones
|
|
# TODO Add support for www. etc.
|
|
# TODO protocol-specific commands with url_cmd as a default.
|
|
my $protocols = 'ftp|https?|git|gopher|mailto|news|nntp|rsync';
|
|
$protocols .= '|telnet|wais|file|prospero';
|
|
my $urlstr = '(' . $protocols . ')://[^\s<>"\'\017\003]+';
|
|
my $urlreg = qr{$urlstr}i;
|
|
|
|
sub hilite_topic {
|
|
my ($data) = @_;
|
|
my $server = $data->{server};
|
|
my $text = $data->{topic};
|
|
my $channel = $data->{name};
|
|
my $nick = $channel;
|
|
my $hostmask = "";
|
|
my $witem;
|
|
|
|
if ($text && $data->{topic_time} > 0) {
|
|
my @links = grep { /$urlreg/ } ( split /($urlreg)/i, $text );
|
|
if (@links) {
|
|
$text = parse_urls( $server, join ("\n", @links) , $nick, $hostmask, $channel );
|
|
|
|
if ($server) {
|
|
$witem = $server->window_item_find($channel);
|
|
}
|
|
else {
|
|
$witem = Irssi::window_item_find($channel);
|
|
}
|
|
|
|
if ($witem) {
|
|
$witem->print( $text, MSGLEVEL_CLIENTCRAP );
|
|
}
|
|
}
|
|
}
|
|
Irssi::signal_continue($data);
|
|
}
|
|
|
|
sub hilite_urls {
|
|
my ( $server, $text, $hostmask ) = @_;
|
|
if ( $text =~ /$urlreg/ && Irssi::settings_get_bool('colour_urls') ) {
|
|
my $ucolour =
|
|
sprintf( "\003%02d", Irssi::settings_get_int('url_colour') );
|
|
my $endcolour = sprintf( "%s", "\017" );
|
|
|
|
# Add Colours
|
|
$text =~ s`($urlreg)`$ucolour$1$endcolour`ig;
|
|
}
|
|
|
|
## Let it flow
|
|
Irssi::signal_continue( $server, $text, $hostmask );
|
|
}
|
|
|
|
sub find_urls {
|
|
my $text = shift;
|
|
my @links = grep { /$urlreg/ } ( split /($urlreg)/i, $text );
|
|
return @links if @links;
|
|
return ();
|
|
}
|
|
|
|
sub parse_urls {
|
|
my ( $server, $text, $nick, $hostmask, $channel ) = @_;
|
|
$server = $server->{tag};
|
|
my @links = find_urls($text);
|
|
return $text unless @links;
|
|
my $index;
|
|
my $ucolour =
|
|
sprintf( "\003%02d", Irssi::settings_get_int('url_colour') );
|
|
my $ncolour =
|
|
sprintf( "\003%02d", Irssi::settings_get_int('url_number_colour') );
|
|
my $endcolour = sprintf( "%s", "\017" );
|
|
|
|
if ( Irssi::settings_get_bool('colour_urls') ) {
|
|
$text =~ s`($urlreg)`$ucolour$1`ig;
|
|
}
|
|
|
|
foreach (@links) {
|
|
|
|
#debug_log("\$_: $_");
|
|
$index = url_log( $server, $channel, $nick, $_ );
|
|
return $text if $index == 0;
|
|
|
|
$text =~ s`\Q$_\E`$_ $ncolour\[$index\]$endcolour`;
|
|
}
|
|
return "$text";
|
|
}
|
|
|
|
sub url_public {
|
|
my ( $server, $text, $nick, $hostmask, $channel ) = @_;
|
|
if ($text) {
|
|
$text = parse_urls( $server, $text, $nick, $hostmask, $channel );
|
|
}
|
|
Irssi::signal_continue( $server, $text, $nick, $hostmask, $channel );
|
|
}
|
|
|
|
sub url_private {
|
|
my ( $server, $text, $nick, $hostmask ) = @_;
|
|
if ($text) {
|
|
$text = parse_urls( $server, $text, $nick, $hostmask, $nick );
|
|
}
|
|
Irssi::signal_continue( $server, $text, $nick, $hostmask );
|
|
}
|
|
|
|
sub url_command {
|
|
my ( $arg, $server, $channel ) = find_server_channel(@_);
|
|
return unless @urls;
|
|
return unless $channel and $server;
|
|
my $url;
|
|
|
|
my @url_list;
|
|
@url_list =
|
|
grep { $_->{server} eq $server && $_->{channel} eq $channel } @urls;
|
|
|
|
return unless @url_list;
|
|
return if abs($arg) > scalar @url_list;
|
|
|
|
if ( $arg > 0 ) {
|
|
my @twat = grep { $_->{index} == $arg } @url_list;
|
|
$url = $twat[0]->{url} if $twat[0];
|
|
}
|
|
else {
|
|
$url = $url_list[$arg]->{url};
|
|
}
|
|
|
|
return unless $url;
|
|
|
|
print CLIENTCRAP "" if Irssi::settings_get_bool('debug_urls');
|
|
debug_log( "\$arg: " . $arg ) if $arg;
|
|
debug_log( "\$server: " . $server ) if $server;
|
|
debug_log( "\$channel: " . $channel ) if $channel;
|
|
Irssi::command( sprintf( Irssi::settings_get_str("url_cmd"), $url ) );
|
|
}
|
|
|
|
sub url_log {
|
|
my ( $server, $channel, $nick, $url ) = @_;
|
|
|
|
# get rid of any colour codes and unprintables
|
|
$url =~ s`\e\[[[:digit:]]+m}``g;
|
|
$url =~ s`(\x03[0-9,]+|\x02)?(\Q$_\E)`$2`g;
|
|
$url =~ s`[^[:print:]]+}``g;
|
|
chomp($url);
|
|
return 0 unless $url;
|
|
|
|
my @url_list;
|
|
my $max = Irssi::settings_get_int('max_urls');
|
|
|
|
@url_list =
|
|
grep { $_->{server} eq $server && $_->{channel} eq $channel } @urls;
|
|
@urls =
|
|
grep { $_->{server} ne $server || $_->{channel} ne $channel } @urls;
|
|
|
|
my $index = scalar @url_list + 1;
|
|
|
|
if ( $index > $max ) {
|
|
$index = $url_list[0]->{index};
|
|
shift @url_list;
|
|
}
|
|
|
|
push @urls, @url_list;
|
|
push @urls,
|
|
{
|
|
index => $index,
|
|
server => $server,
|
|
channel => $channel,
|
|
nick => $nick,
|
|
url => $url,
|
|
};
|
|
|
|
debug_log(
|
|
scalar @urls . ' '
|
|
. $urls[-1]->{index} . ' '
|
|
. $urls[-1]->{server} . ' '
|
|
. $urls[-1]->{channel} . ' '
|
|
. $urls[-1]->{nick} . ' '
|
|
. $urls[-1]->{url} );
|
|
return $index;
|
|
}
|
|
|
|
sub clear_urls {
|
|
return unless @urls;
|
|
@urls = ();
|
|
Irssi::command("/echo URL list cleared\n");
|
|
}
|
|
|
|
sub find_server_channel {
|
|
my ( $mitem, $server, $channel ) = @_;
|
|
my $arg = 0;
|
|
my $name;
|
|
my ( $refnum, $buffer );
|
|
( $arg, $name ) = split ' ', $mitem;
|
|
|
|
if ($server) {
|
|
$server = $server->{tag};
|
|
}
|
|
else {
|
|
$server = Irssi::active_win->{'active'}->{'server'}->{'tag'};
|
|
}
|
|
if ($channel) {
|
|
$channel = $channel->{name};
|
|
}
|
|
else {
|
|
$channel = Irssi::active_win->{'active'}->{'name'};
|
|
}
|
|
|
|
$channel = Irssi::active_win->{name} unless $channel;
|
|
$refnum = do { no warnings "numeric"; int($name) } if $name;
|
|
$arg = -1 unless $arg;
|
|
|
|
if ( not $name and abs($arg) =~ /\D+/ ) {
|
|
$name = $arg;
|
|
$arg = -1;
|
|
}
|
|
|
|
if ($name) {
|
|
if ($refnum) {
|
|
$buffer = Irssi::window_find_refnum($refnum);
|
|
}
|
|
else {
|
|
$buffer = Irssi::window_find_closest( $name, 0 );
|
|
}
|
|
}
|
|
if ($buffer) {
|
|
$channel = $buffer->get_active_name;
|
|
$server = $buffer->{active_server}->{'tag'};
|
|
}
|
|
|
|
$arg = int($arg);
|
|
return ( $arg, $server, $channel );
|
|
}
|
|
|
|
# Below here mostly useful for debugging
|
|
sub list_urls {
|
|
my ( $arg, $server, $channel ) = find_server_channel(@_);
|
|
return unless @urls;
|
|
return unless $channel and $server;
|
|
|
|
my @url_list;
|
|
@url_list =
|
|
grep { $_->{server} eq $server && $_->{channel} eq $channel } @urls;
|
|
|
|
my $nurls = @url_list;
|
|
return unless $nurls;
|
|
|
|
if ( int($arg) < 0 ) {
|
|
for ( my $cnt = -1 ; $cnt >= $arg && $nurls + $cnt >= 0 ; $cnt-- ) {
|
|
print_log_entry( \@url_list, $cnt, $nurls + $cnt );
|
|
}
|
|
}
|
|
elsif ( int($arg) > 0 ) {
|
|
for ( my $cnt = 1 ; $cnt <= $arg && $cnt <= $nurls ; $cnt++ ) {
|
|
print_log_entry( \@url_list, $cnt, $cnt - 1 );
|
|
}
|
|
}
|
|
}
|
|
|
|
sub whoami { ( caller(1) )[3] }
|
|
sub whowasi { ( caller(2) )[3] }
|
|
|
|
sub debug_log {
|
|
return if Irssi::settings_get_bool('debug_urls') == 0;
|
|
my $data = ( join ' ', @_ ) =~ s{%}{%%}gr;
|
|
my @sub = split '::', whowasi();
|
|
print CLIENTCRAP "$sub[2]::$sub[3]: $data";
|
|
}
|
|
|
|
sub print_log_entry {
|
|
my ( $list, $cnt, $idx ) = @_;
|
|
my @url_list = @{$list};
|
|
my $string =
|
|
"$cnt" . ' '
|
|
. $url_list[$idx]->{server} . ' '
|
|
. $url_list[$idx]->{channel} . ' '
|
|
. $url_list[$idx]->{nick} . ' '
|
|
. $url_list[$idx]->{url} . ' '
|
|
. "[$url_list[$idx]->{index}]";
|
|
|
|
Irssi::command("/echo -- $string\n");
|
|
}
|
|
|
|
# vim: expandtab tabstop=4 softtabstop=4 shiftwidth=4
|