From 00f7c03c9ad2e9dddf92f679b0f59c8d6b47a37a Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Mon, 7 May 2018 18:06:17 +1200
Subject: Replace HTML::HeadParser with HTML::Parser
Weird bugs with HeadParser, cannot debug and patch for upstream as yet
---
Plugin/URL_Title.pm | 22 +++++++++++++++++-----
1 file changed, 17 insertions(+), 5 deletions(-)
diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm
index 8248560..5774528 100644
--- a/Plugin/URL_Title.pm
+++ b/Plugin/URL_Title.pm
@@ -5,7 +5,7 @@ package Plugin::URL_Title;
use strict;
use warnings;
use HTTP::Tiny;
-use HTML::HeadParser;
+use HTML::Parser;
use utf8;
my %config;
@@ -18,6 +18,17 @@ sub configure {
return $self;
}
+my $title;
+
+sub start_handler
+{
+ return if shift ne "title";
+ my $self = shift;
+ $self->handler(text => sub { $title = shift; }, "dtext");
+ $self->handler(end => sub { shift->eof if shift eq "title"; },
+ "tagname,self");
+}
+
sub message
{
my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_;
@@ -47,11 +58,12 @@ sub message
my $html = $response->{content};
utf8::decode($html);
- my $parser = HTML::HeadParser->new;
- $parser->parse($html);
+ $title = "";
+ my $p = HTML::Parser->new(api_version => 3);
+ $p->handler( start => \&start_handler, "tagname,self");
+ $p->parse($html);
+ die "Error: $!\n" if $!;
- # get title and unpack from utf8 (assumption)
- my $title = $parser->header("title");
utf8::upgrade($title);
return unless $title;
--
cgit v1.1
From 817ebdeb8eeaa344fd77a2c84d4e90d4cdf5f66a Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Mon, 7 May 2018 20:57:27 +1200
Subject: Fold URL title whitespace into same line
---
Plugin/URL_Title.pm | 3 +++
1 file changed, 3 insertions(+)
diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm
index 5774528..1d0056e 100644
--- a/Plugin/URL_Title.pm
+++ b/Plugin/URL_Title.pm
@@ -64,6 +64,9 @@ sub message
$p->parse($html);
die "Error: $!\n" if $!;
+ $title =~ s/\s+/ /g;
+ $title =~ s/(^\s+|\s+$)//g;
+
utf8::upgrade($title);
return unless $title;
--
cgit v1.1
From eb2ff6434ee9ffe9354539186bbb7b8726788e0f Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Mon, 7 May 2018 21:17:47 +1200
Subject: Truncate URLs based on shorturl length, not full URL
---
Plugin/URL_Title.pm | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm
index 1d0056e..3297bed 100644
--- a/Plugin/URL_Title.pm
+++ b/Plugin/URL_Title.pm
@@ -71,12 +71,13 @@ sub message
return unless $title;
my $shorturl = $url;
- $shorturl = (substr $url, 0, $config{url_len}) . "…" if length ($url) > $config{url_len};
-
# remove http(s):// to avoid triggering other poorly configured bots
$shorturl =~ s,^https?://,,g;
$shorturl =~ s,/$,,g;
+ # truncate URL without http(s):// to configured length if needed
+ $shorturl = (substr $shorturl, 0, $config{url_len}) . "…" if length ($shorturl) > $config{url_len};
+
my $composed_title = "$title ($shorturl)";
return $composed_title;
}
--
cgit v1.1
From 56cf40827f8c54926936ecfbb256651493c70750 Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Wed, 16 May 2018 14:02:49 +1200
Subject: Add command to inspect ignores
---
idalius.pl | 4 ++++
1 file changed, 4 insertions(+)
diff --git a/idalius.pl b/idalius.pl
index c88ed8e..fd44242 100755
--- a/idalius.pl
+++ b/idalius.pl
@@ -294,6 +294,10 @@ sub irc_msg {
$irc->yield(privmsg => $nick => "Syntax: topic <channel> <topic>");
}
}
+ if ($what =~ /^who are you ignoring/) {
+ my $ignores = join ", ", @{$config{ignore}};
+ $irc->yield(privmsg => $nick => "I am ignoring: $ignores");
+ }
if ($what =~ /^mode\s/) {
my ($rest) = $what =~ /^mode\s+(.*)?$/;
if ($rest) {
--
cgit v1.1
From 7ef75e83372ff08223ff1ad31891cb0586abdff3 Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Thu, 17 May 2018 21:32:55 +1200
Subject: Lower spam limit, tell person we ignore
---
idalius.pl | 11 ++++++-----
1 file changed, 6 insertions(+), 5 deletions(-)
diff --git a/idalius.pl b/idalius.pl
index fd44242..4c9c8f3 100755
--- a/idalius.pl
+++ b/idalius.pl
@@ -109,10 +109,10 @@ sub drop_priv {
# This differs from antiflood.pm in that it is used only for when users have
# triggered a response from the bot.
sub strike_add {
- my $strike_count = 15;
- my $strike_period = 30;
+ my $strike_count = 14;
+ my $strike_period = 45;
- my ($nick) = @_;
+ my ($nick, $channel) = @_;
my $now = time();
push @{$laststrike{$nick}}, $now;
if (@{$laststrike{$nick}} >= $strike_count) {
@@ -120,6 +120,7 @@ sub strike_add {
my $first = @{$laststrike{$nick}}[0];
if ($now - $first <= $strike_period) {
log_info "Ignoring $nick because of command flood";
+ $irc->yield(privmsg => $channel => "$nick: I'm ignoring you now, you've caused me to talk too much");
push @{$config{ignore}}, $nick;
}
}
@@ -181,7 +182,7 @@ sub irc_public {
if ($stripped_what =~ s/^$config{prefix}//) {
$output = run_command($stripped_what, $who, $where);
$irc->yield(privmsg => $where => $output) if $output;
- strike_add $nick if $output;
+ strike_add($nick, $channel) if $output;
}
for my $module (@plugin_list) {
@@ -189,7 +190,7 @@ sub irc_public {
if ($module->can("message")) {
$output = $module->message(\&log_info, $irc->nick_name, $who, $where, $what, $stripped_what, $irc);
}
- strike_add $nick if $output;
+ strike_add($nick, $channel) if $output;
$irc->yield(privmsg => $where => $output) if $output;
}
--
cgit v1.1
From b1f4150fc408b00e20117be28ff111a3d3c27fa8 Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Fri, 18 May 2018 14:11:54 +1200
Subject: Correct order of ignore message
---
idalius.pl | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/idalius.pl b/idalius.pl
index 4c9c8f3..89c89e5 100755
--- a/idalius.pl
+++ b/idalius.pl
@@ -190,8 +190,8 @@ sub irc_public {
if ($module->can("message")) {
$output = $module->message(\&log_info, $irc->nick_name, $who, $where, $what, $stripped_what, $irc);
}
- strike_add($nick, $channel) if $output;
$irc->yield(privmsg => $where => $output) if $output;
+ strike_add($nick, $channel) if $output;
}
return;
--
cgit v1.1
From 53718f690df53285362145ee474f40a2f5cc63e7 Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Tue, 19 Jun 2018 00:12:14 +1200
Subject: URL_Title: Allow SVG titling
---
Plugin/URL_Title.pm | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm
index 3297bed..6d46e43 100644
--- a/Plugin/URL_Title.pm
+++ b/Plugin/URL_Title.pm
@@ -41,7 +41,9 @@ sub message
}
return unless $url;
- my $http = HTTP::Tiny->new((default_headers => {'Range' => "bytes=0-65536", 'Accept' => 'text/html'}, timeout => 3));
+ # FIXME add more XML-based formats that we can theoretically extract titles from
+ # FIXME factor out accepted formats and response match into accepted formats array
+ my $http = HTTP::Tiny->new((default_headers => {'Range' => "bytes=0-65536", 'Accept' => 'text/html, image/svg+xml'}, timeout => 3));
my $response = $http->get($url);
@@ -50,8 +52,8 @@ sub message
return;
}
- if (!($response->{headers}->{"content-type"} =~ m,text/html ?,)) {
- $logger->("Not html, giving up now");
+ if (!($response->{headers}->{"content-type"} =~ m,(text/html|image/svg\+xml),)) {
+ $logger->("I don't think I can parse titles from $response->{headers}->{'content-type'} - stopping here");
return;
}
--
cgit v1.1
From 792eade6c29beb6cf9b1e31ddffdc6476ff21b01 Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Wed, 20 Jun 2018 17:41:52 +1200
Subject: Change URL parsing from space to RFC 3982
---
Plugin/URL_Title.pm | 3 ++-
1 file changed, 2 insertions(+), 1 deletion(-)
diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm
index 6d46e43..a2c8930 100644
--- a/Plugin/URL_Title.pm
+++ b/Plugin/URL_Title.pm
@@ -36,7 +36,8 @@ sub message
return if ($config{url_on} == 0);
- if ($what =~ /(https?:\/\/[^ ]+)/i) {
+ # Drawn from RFC 3986§2
+ if ($what =~ /(https?:\/\/[A-z0-9\-\._~:\/\?#\[\]@\!\$&'()\*\+,;=]+)/i) {
$url = $1;
}
return unless $url;
--
cgit v1.1
From 549ac4f97e0a70238006cc7b4d4ff752f281b930 Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Wed, 20 Jun 2018 17:49:19 +1200
Subject: No need for [A-z] when case-insensitive flag used
---
Plugin/URL_Title.pm | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/Plugin/URL_Title.pm b/Plugin/URL_Title.pm
index a2c8930..73fa498 100644
--- a/Plugin/URL_Title.pm
+++ b/Plugin/URL_Title.pm
@@ -37,7 +37,7 @@ sub message
return if ($config{url_on} == 0);
# Drawn from RFC 3986§2
- if ($what =~ /(https?:\/\/[A-z0-9\-\._~:\/\?#\[\]@\!\$&'()\*\+,;=]+)/i) {
+ if ($what =~ /(https?:\/\/[a-z0-9\-\._~:\/\?#\[\]@\!\$&'()\*\+,;=]+)/i) {
$url = $1;
}
return unless $url;
--
cgit v1.1
From ca1ba1ad6825e93bf6be91317ffdf57d076ad798 Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Tue, 26 Jun 2018 21:39:33 +1200
Subject: Use tidier format for time
---
Plugin/Timezone.pm | 5 +++--
1 file changed, 3 insertions(+), 2 deletions(-)
diff --git a/Plugin/Timezone.pm b/Plugin/Timezone.pm
index eaea907..60a0f34 100644
--- a/Plugin/Timezone.pm
+++ b/Plugin/Timezone.pm
@@ -30,9 +30,10 @@ sub time {
my $nick = $arguments[0];
if (grep {$_ eq $nick} @known_zones) {
- my $d = DateTime->now();
+ my $d = DateTime->now();
$d->set_time_zone($config{timezone}->{$nick});
- return "$requester: $nick\'s clock reads $d";
+ my $timestr = $d->strftime("%Y-%m-%d %H:%M %Z");
+ return "$requester: $nick\'s clock reads $timestr";
} else {
return "$requester: I don't know what timezone $nick is in";
}
--
cgit v1.1
From e56d58c07ccfe7d3e5ab9439d688259b70d60d95 Mon Sep 17 00:00:00 2001
From: David Phillips <david@sighup.nz>
Date: Sat, 14 Jul 2018 19:34:37 +1200
Subject: Fix typo in module name
---
Plugin/Titillate.pm | 37 +++++++++++++++++++++++++++++++++++++
Plugin/Tittilate.pm | 37 -------------------------------------
2 files changed, 37 insertions(+), 37 deletions(-)
create mode 100644 Plugin/Titillate.pm
delete mode 100644 Plugin/Tittilate.pm
diff --git a/Plugin/Titillate.pm b/Plugin/Titillate.pm
new file mode 100644
index 0000000..f969df7
--- /dev/null
+++ b/Plugin/Titillate.pm
@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+package Plugin::Titillate;
+
+use strict;
+use warnings;
+
+my %config;
+
+sub configure {
+ my $self = $_[0];
+ my $cmdref = $_[1];
+ my $cref = $_[2];
+ %config = %$cref;
+ return $self;
+}
+
+sub message {
+ my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_;
+ my $gathered = "";
+ my @expressions = (keys %{$config{triggers}});
+ my $expression = join '|', @expressions;
+ while ($what =~ /($expression)/gi) {
+ my $matched = $1;
+ my $key;
+ # figure out which key matched
+ foreach (@expressions) {
+ if ($matched =~ /$_/i) {
+ $key = $_;
+ last;
+ }
+ }
+ $gathered .= $config{triggers}->{$key};
+ }
+ return $gathered;
+}
+1;
diff --git a/Plugin/Tittilate.pm b/Plugin/Tittilate.pm
deleted file mode 100644
index b2c2286..0000000
--- a/Plugin/Tittilate.pm
+++ /dev/null
@@ -1,37 +0,0 @@
-#!/usr/bin/env perl
-
-package Plugin::Tittilate;
-
-use strict;
-use warnings;
-
-my %config;
-
-sub configure {
- my $self = $_[0];
- my $cmdref = $_[1];
- my $cref = $_[2];
- %config = %$cref;
- return $self;
-}
-
-sub message {
- my ($self, $logger, $me, $who, $where, $raw_what, $what, $irc) = @_;
- my $gathered = "";
- my @expressions = (keys %{$config{triggers}});
- my $expression = join '|', @expressions;
- while ($what =~ /($expression)/gi) {
- my $matched = $1;
- my $key;
- # figure out which key matched
- foreach (@expressions) {
- if ($matched =~ /$_/i) {
- $key = $_;
- last;
- }
- }
- $gathered .= $config{triggers}->{$key};
- }
- return $gathered;
-}
-1;
--
cgit v1.1