X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=scripts%2Fssoma-replay;h=071214230ac42a9b1bb1ce7e79e54d986d898892;hb=a479b45117ed69d9311770fa39e6676d38f9cab2;hp=91c121dd2f0e3eda8b1232d8c8cdfbab325ec8d7;hpb=fcfef9420b639214b325dd17f8a7ae151c21f627;p=public-inbox.git
diff --git a/scripts/ssoma-replay b/scripts/ssoma-replay
index 91c121dd..07121423 100755
--- a/scripts/ssoma-replay
+++ b/scripts/ssoma-replay
@@ -1,5 +1,5 @@
#!/usr/bin/perl -w
-# Copyright (C) 2015-2016 all contributors
+# Copyright (C) 2015-2020 all contributors
# License: AGPL-3.0+
#
# A work-in-progress, but one day I hope this script is no longer
@@ -30,10 +30,7 @@ use Email::Simple;
use URI::Escape qw/uri_escape_utf8/;
use File::Temp qw/tempfile/;
my ($fh, $filename) = tempfile('ssoma-replay-XXXXXXXX', TMPDIR => 1);
-my $msg = eval {
- local $/;
- Email::Simple->new();
-};
+my $msg = Email::Simple->new(do { local $/; });
select $fh;
# Note: the archive URL makes assumptions about where the
@@ -45,15 +42,18 @@ my $body = $msg->body;
my $list_id = $header_obj->header('List-Id');
my ($archive_url, $user, $domain);
if (defined $list_id) {
- ($user, $domain) = ($list_id =~ /<(.+)\@(.+)>/g);
+ # due to a bug in old versions of public-inbox, was used
+ # as the list-Id instead of as recommended in RFC2919
+ ($user, $domain) = ($list_id =~ /<([^\.@]+)[\.@](.+)>/g);
if (defined $domain) {
$archive_url = "https://$domain/$user/";
my $mid = $header_obj->header('Message-Id');
- if ($mid =~ /\A<(.+)>\z/) {
+ if ($mid =~ /<[ \t]*([^>]+)?[ \t]*>/s) {
$mid = $1;
}
- $mid = uri_escape_utf8($mid);
+ $mid = uri_escape_utf8($mid,
+ '^A-Za-z0-9\-\._~!\$\&\';\(\)\*\+,;=:@');
$header_obj->header_set('List-Archive', "<$archive_url>");
foreach my $h (qw(Help Unsubscribe Subscribe Owner)) {