Wie man bedingten Regex globalen Ersatz mit Perl machen?

Question

Ich habe eine Variable $content enthält einen Absatz von gemischten Text und HTML-Tags img und URLs.

Ich möchte bedingte String-Injektion machen, um etwas Ersatz zu tun.

Angenommen, $content

ABC <img src="http://url1.com/keep.jpg"> 
DEF <img src="http://random-url.com/replace.jpg"> 
GHI <img src="http://url2.com/keep.jpg"> 

enthält würde ich $content bearbeiten möchten und machen es

ABC <img src="http://url1.com/keep.jpg"> 
DEF <img src="http://wrapper-url.com/random-url.com/replace.jpg"> 
GHI <img src="http://url2.com/keep.jpg"> 

ich eine Liste von regex Bedingungen für URLs zu halten: die genannten weißen Liste Streichhölzer. Jede andere Bild-URL als die Whitelist wird mit einem Wrapper-URL-Präfix bearbeitet.

Meine Idee war:

if image tags matched in $content { 
    if match is in 'whitelist' 
    do nothing 
    else 
    inject prefix replacement 
} 

Ich weiß nicht, wie bedingten regex globalen Ersatz zu machen, da alles in einem einzeiligen String-Variable ist.

Ich muss dies in Perl implementieren.

---

Zusätzliche Informationen:

Meine 'Whitelist' sind nur noch 5 Zeilen, im Grunde enthält Schlüsselwort und Domänen.

Hier ist, was ich für den Abgleich der "Whitelist" getan habe.

z.

if ($_ =~ /s3\.static\.cdn\.net/) { 
    # whitelist to keep, subdomain match 
} 
elsif ($_ =~ /keyword-to-keep/) { 
    # whitelist to keep, url keyword match 
} 
elsif ($_ =~ /cdn\.domain\.com/) { 
    # whitelist to keep, subdomain match 
} 
elsif ($_ =~ /whitelist-domain\.net/) { 
    # whitelist to keep, domain match 
} 
elsif ($_ =~ /i\.whitelist-domain\.com/) { 
    # whitelist to keep, subdomain match 
} 
else { 
    # matched, do something about it with injection 
} 

---

Eine nicht ganz so elegant Lösung, die ich denken kann, ist alle img Urls mit dem Präfix Injektion global ersetzen.

Führen Sie dann einen weiteren globalen Ersatz durch, um das Präfix durch einen Abgleich mit der "Whitelist" zu entfernen.

Gibt es eine effizientere Lösung für mein Problem?

Danke.

Answer 1

1. können Sie HTML:TokeParser:Simple verwenden, um ein img-Tag zu finden und die URL von seinem Attribut src zu extrahieren.

2. Sie können den Hostnamen aus der URL mit URI:URL extrahieren.

3. Sie können Ihre Whitelist in a set für einfache und effiziente Hostnamen-Lookups konvertieren.

4. Sie können den Operator s// zu wrap Hostnamen verwenden, die nicht in der Whitelist enthalten sind.

---

use strict; 
use warnings; 
use 5.020; 
use HTML::TokeParser::Simple; 
use URI::URL; 
use List::Util qw{ any }; 

my @white_list = qw(
    s3.static.cdn.net 
    cdn.domain.com 
    whitelist-domain.net 
    i.whitelist-domain.com 
); 
#Create a set: 
my %white_list = map {$_ => undef} @white_list; 

my @accepted_keywords = qw(
    xxx.xxx 
    cool 
); 
#Escape any special regex characters appearing in the keywords: 
@accepted_keywords = map { quotemeta $_ } @accepted_keywords; 

my $wrapper_host = "wrapper-url.com"; 

my $content = <<END_OF_CONTENT; 
ABC <img src="http://i.whitelist-domain.com/keep.jpg"> 
DEF <img src="http://random-url.com/replace.jpg"> 
GHI <img src="http://cdn.domain.com/keep.jpg"> 
XYZ <img src="http://random-url.com/replace.jpg"> 
ZZZ <img src="http://xxx.xxx/keep.jpg"> 
ZZZ <img src="http://xxxXxxx/replace.jpg"> 
ZZZ <img src="http://waycool.com/keep.jpg"> 
END_OF_CONTENT 

my $parser = HTML::TokeParser::Simple->new(\$content); 

my ($src, $url, $host, $regex); 
while (my $token = $parser->get_token()) { 

    if ($token->is_tag('img')) { 
     if ($src = $token->get_attr('src')) { 
      $url = URI::URL->new($src); 
      $host = $url->host; 

      next if exists($white_list{$host}); 
      next if any { $host =~ /$_/ } @accepted_keywords; 

      $src =~ s/(http:\/\/)/$1$wrapper_host\//xms; 
      $token->set_attr(
       'src', 
       $src, 
      ); 

     } 
    } 
} 
continue { 
    print $token->as_is; 
} 

--output:-- 
ABC <img src="http://i.whitelist-domain.com/keep.jpg"> 
DEF <img src="http://wrapper-url.com/random-url.com/replace.jpg"> 
GHI <img src="http://cdn.domain.com/keep.jpg"> 
XYZ <img src="http://wrapper-url.com/random-url.com/replace.jpg"> 
ZZZ <img src="http://xxx.xxx/keep.jpg"> 
ZZZ <img src="http://wrapper-url.com/xxxXxxx/replace.jpg"> 
ZZZ <img src="http://waycool.com/keep.jpg"> 

Answer 2

Wie andere bereits erwähnt haben, wird die Verwendung von RE's zum Parsen von HTML dringend empfohlen - siehe here (aus vielen anderen Orten) aus den Gründen.

Da Ihre Beispieldaten kurz und einfach sind, können Sie den Rat ignorieren, solange Sie die Einschränkungen berücksichtigen. Einige der

Dinge zu beachten sind;

1. Was passiert, wenn Ihr Whitelist-Keyword mit einem Teil der Domain übereinstimmt?
2. oder umgekehrt - was ist, wenn eine Domain (.net) Teil des Pfades ist?
3. Was passiert, wenn das Schema etwas anderes als http (s) ist?
4. Was ist, wenn die URL nicht in Anführungszeichen gesetzt ist? oder irgendwelche Zitate überhaupt?
5. Was passiert, wenn im "Vortext" etwas wie ein Tag aussieht?
6. Sind Einträge auf der Whitelist Groß-und Kleinschreibung beachten? Domain-Namen sind nicht; Pfade sind; Also was zu tun?

Ein paar Prinzipien, die ich in der folgenden Lösung verwendet habe, sind;

• separate regex Spezifikation von regex Verwendung
• immer erweiterten Modus regexs IE verwenden: use '/ x' Option
• Vorprozess der weiße Liste eine Reihe von RE "Tests" zu machen
• passieren Unix-Filter-Stil - auf STDIN lesen, schreiben auf STDOUT, auf STDERR warnen
• ein Modul für das Detail der Handhabung Teile der URL verwenden

diese Dinge gegeben zu bedenken, das wird es grundsätzlich tun;

use v5.12; 
use URI::URL; 

my $wrapper_host = "wrapper-url.com" ; 
my $whitelist_file = "whitelist.txt" ; 
URI::URL::strict 1; # Will croak if cannot determine scheme 

my $text_re = qr/^(\s* [^<]+ \s*) /x ; 
my $quoted_str = qr/ " ([^"]+) " /x ; 
my $img_tag_re = qr/ < img \s+ src= $quoted_str > /x ; 

my @whitelist_rules ; 
open(my $white, '<', $whitelist_file) or die "$whitelist_file: $!\n" ; 
while (<$white>) { 
    chomp; 
    s/\./\\./; # escape '.' 
    push @whitelist_rules, qr/$_/ ; 
} 
close $white ; 

while (<>) { 

    # Parse the line into text and url 
    my $text; my $url; 
    if (/ $text_re $img_tag_re /x) { 
     $text = $1 ; 
     $url = new URI::URL $2 ; # may croak 
    } 
    else { 
     warn "Can't make sense of line $., skipping..." ; 
     next ; 
    } 

    # iterate over @whitelist_rules to see if this one is exempt 
    my $on_whitelist = 0; 
    for my $r (@whitelist_rules) { 
     $on_whitelist++ if $url =~ /$r/i ;   # Note: '/i' 
     # $on_whitelist++ if $url->netloc =~ /$r/i ; # alternatively ... 
     # $on_whitelist++ if $url->path =~ /$r/i ; # alternatively ... 
    } 

    # If its not on the whitelist, wrap netloc 
    if (! $on_whitelist) { 
     $url->path($url->netloc . $url->path); 
     $url->netloc($wrapper_host); 
    } 

    # output the transformed line 
    say $text . $url ; 
}