X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FLinkify.pm;h=175f8d724dbb25e2d8e04f89a2a1792373d83b3c;hb=9bd675d33ad1e49bd2ebe12a1d216216e61380de;hp=cc0f7e3a5a3a775d3744100a0e67e3f71a11a3db;hpb=130d0c4e33c5c73dc69e270fc698735d49e0f159;p=public-inbox.git diff --git a/lib/PublicInbox/Linkify.pm b/lib/PublicInbox/Linkify.pm index cc0f7e3a..175f8d72 100644 --- a/lib/PublicInbox/Linkify.pm +++ b/lib/PublicInbox/Linkify.pm @@ -1,4 +1,4 @@ -# Copyright (C) 2014-2016 all contributors +# Copyright (C) 2014-2019 all contributors # License: AGPL-3.0+ # two-step linkification. @@ -13,57 +13,72 @@ package PublicInbox::Linkify; use strict; use warnings; use Digest::SHA qw/sha1_hex/; +use PublicInbox::Hval qw(ascii_html); my $SALT = rand; -my $LINK_RE = qr{(\()?\b((?:ftps?|https?|nntps?|gopher):// - [\@:\w\.-]+/ +my $LINK_RE = qr{([\('!])?\b((?:ftps?|https?|nntps?|gopher):// + [\@:\w\.-]+(?:/ (?:[a-z0-9\-\._~!\$\&\';\(\)\*\+,;=:@/%]*) (?:\?[a-z0-9\-\._~!\$\&\';\(\)\*\+,;=:@/%]+)? (?:\#[a-z0-9\-\._~!\$\&\';\(\)\*\+,;=:@/%\?]+)? - )}xi; + )? + )}xi; -sub new { bless {}, shift } +sub new { bless {}, $_[0] } + +# try to distinguish paired punctuation chars from the URL itself +# Maybe other languages/formats can be supported here, too... +my %pairs = ( + "(" => qr/(\)[\.,;\+]?)\z/, # Markdown (,), Ruby (+) (, for arrays) + "'" => qr/('[\.,;\+]?)\z/, # Perl / Ruby + "!" => qr/(![\.,;\+]?)\z/, # Perl / Ruby +); sub linkify_1 { - my ($self, $s) = @_; - $s =~ s!$LINK_RE! + $_[1] =~ s^$LINK_RE^ my $beg = $1 || ''; my $url = $2; my $end = ''; - # Markdown compatibility: - if ($beg eq '(') { - $url =~ s/\)\z//; - $end = ')'; - } - # it's fairly common to end URLs in messages with # '.', ',' or ';' to denote the end of a statement; # assume the intent was to end the statement/sentence # in English - if ($url =~ s/([\.,;])\z//) { - $end = $1 . $end; + if (defined(my $re = $pairs{$beg})) { + if ($url =~ s/$re//) { + $end = $1; + } + } elsif ($url =~ s/(\))?([\.,;])\z//) { + $end = $2; + # require ')' to be paired with '(' + if (defined $1) { # ')' + if (index($url, '(') < 0) { + $end = ")$end"; + } else { + $url .= ')'; + } + } + } elsif ($url !~ /\(/ && $url =~ s/\)\z//) { + $end = ')'; } + $url = ascii_html($url); # for IDN + # salt this, as this could be exploited to show # links in the HTML which don't show up in the raw mail. my $key = sha1_hex($url . $SALT); - # only escape ampersands, others do not match LINK_RE - $url =~ s/&/&/g; - $self->{$key} = $url; + $_[0]->{$key} = $url; $beg . 'PI-LINK-'. $key . $end; - !ge; - $s; + ^ge; + $_[1]; } sub linkify_2 { - my ($self, $s) = @_; - # Added "PI-LINK-" prefix to avoid false-positives on git commits - $s =~ s!\bPI-LINK-([a-f0-9]{40})\b! + $_[1] =~ s!\bPI-LINK-([a-f0-9]{40})\b! my $key = $1; - my $url = $self->{$key}; + my $url = $_[0]->{$key}; if (defined $url) { "$url"; } else { @@ -71,7 +86,7 @@ sub linkify_2 { $key; } !ge; - $s; + $_[1]; } 1;