4 files changed, 144 insertions, 10 deletions

diff --git a/perllib/FixMyStreet/App/View/Web.pm b/perllib/FixMyStreet/App/View/Web.pm
index 1e1b50094..41444fdd4 100644
--- a/perllib/FixMyStreet/App/View/Web.pm
+++ b/perllib/FixMyStreet/App/View/Web.pm
@@ -25,7 +25,7 @@ __PACKAGE__->config(
     FILTERS => {
         add_links => \&add_links,
         escape_js => \&escape_js,
-        markup => [ \&markup_factory, 1 ],
+        staff_html_markup => [ \&staff_html_markup_factory, 1 ],
     },
     COMPILE_EXT => '.ttc',
     STAT_TTL    => FixMyStreet->config('STAGING_SITE') ? 1 : 86400,
@@ -100,7 +100,7 @@ sub add_links {
     my $text = shift;
     $text = FixMyStreet::Template::conditional_escape($text);
     $text =~ s/\r//g;
-    $text =~ s{(https?://)([^\s]+)}{"<a href=\"$1$2\">$1" . _space_slash($2) . '</a>'}ge;
+    $text =~ s{(?<!["'])(https?://)([^\s]+)}{"<a href=\"$1$2\">$1" . _space_slash($2) . '</a>'}ge;
     return FixMyStreet::Template::SafeString->new($text);
 }
 
@@ -110,21 +110,50 @@ sub _space_slash {
     return $t;
 }
 
-=head2 markup_factory
+=head2 staff_html_markup_factory
 
-This returns a function that will allow updates to have markdown-style italics.
-Pass in the user that wrote the text, so we know whether it can be privileged.
+This returns a function that processes the text body of an update, applying
+HTML sanitization and markdown-style italics if it was made by a staff user.
+
+Pass in the update extra, so we can determine if it was made by a staff user.
 
 =cut
 
-sub markup_factory {
-    my ($c, $user) = @_;
+sub staff_html_markup_factory {
+    my ($c, $extra) = @_;
+
+    my $staff = $extra->{is_superuser} || $extra->{is_body_user};
+
     return sub {
         my $text = shift;
-        return $text unless $user && ($user->from_body || $user->is_superuser);
-        $text =~ s{\*(\S.*?\S)\*}{<i>$1</i>};
-        FixMyStreet::Template::SafeString->new($text);
+        return _staff_html_markup($text, $staff);
+    }
+}
+
+sub _staff_html_markup {
+    my ( $text, $staff ) = @_;
+    unless ($staff) {
+        return FixMyStreet::Template::html_paragraph(add_links($text));
+    }
+
+    $text = FixMyStreet::Template::sanitize($text);
+
+    # Apply Markdown-style italics
+    $text =~ s{\*(\S.*?\S)\*}{<i>$1</i>};
+
+    # Mark safe so add_links doesn't escape everything.
+    $text = FixMyStreet::Template::SafeString->new($text);
+
+    $text = add_links($text);
+
+    # If the update already has block-level elements then don't wrap
+    # individual lines in <p> elements, as we assume the user knows what
+    # they're doing.
+    unless ($text =~ /<(p|ol|ul)>/) {
+        $text = FixMyStreet::Template::html_paragraph($text);
     }
+
+    return $text;
 }
 
 =head2 escape_js
diff --git a/perllib/FixMyStreet/Script/Alerts.pm b/perllib/FixMyStreet/Script/Alerts.pm
index 03373a8cc..fa90ede48 100644
--- a/perllib/FixMyStreet/Script/Alerts.pm
+++ b/perllib/FixMyStreet/Script/Alerts.pm
@@ -41,6 +41,7 @@ sub send() {
                    $item_table.photo as item_photo,
                    $item_table.problem_state as item_problem_state,
                    $item_table.cobrand as item_cobrand,
+                   $item_table.extra as item_extra,
                    $head_table.*
             from alert, $item_table, $head_table
                 where alert.parameter::integer = $head_table.id
diff --git a/perllib/FixMyStreet/Template.pm b/perllib/FixMyStreet/Template.pm
index 6317f7552..35efcc1cf 100644
--- a/perllib/FixMyStreet/Template.pm
+++ b/perllib/FixMyStreet/Template.pm
@@ -7,10 +7,14 @@ use FixMyStreet;
 use mySociety::Locale;
 use Attribute::Handlers;
 use HTML::Scrubber;
+use HTML::TreeBuilder;
 use FixMyStreet::Template::SafeString;
 use FixMyStreet::Template::Context;
 use FixMyStreet::Template::Stash;
 
+use RABX;
+use IO::String;
+
 my %FILTERS;
 my %SUBS;
 
@@ -141,6 +145,8 @@ sub html_paragraph : Filter('html_para') {
 sub sanitize {
     my $text = shift;
 
+    $text = $$text if UNIVERSAL::isa($text, 'FixMyStreet::Template::SafeString');
+ 
     my %allowed_tags = map { $_ => 1 } qw( p ul ol li br b i strong em );
     my $scrubber = HTML::Scrubber->new(
         rules => [
@@ -155,4 +161,84 @@ sub sanitize {
     return $text;
 }
 
+
+=head2 email_sanitize_text
+
+Intended for use in the _email_comment_list.txt template to allow HTML
+in updates from staff/superusers. Sanitizes the HTML and then converts
+it all to text.
+
+=cut
+
+sub email_sanitize_text : Fn('email_sanitize_text') {
+    my $update = shift;
+
+    my $text = $update->{item_text};
+    my $extra = $update->{item_extra};
+    $extra = $extra ? RABX::wire_rd(new IO::String($extra)) : {};
+
+    my $staff = $extra->{is_superuser} || $extra->{is_body_user};
+
+    return $text unless $staff;
+
+    $text = FixMyStreet::Template::sanitize($text);
+
+    my $tree = HTML::TreeBuilder->new_from_content($text);
+    _sanitize_elt($tree);
+
+    return $tree->as_text;
+}
+
+my $list_type;
+my $list_num;
+my $sanitize_text_subs = {
+    b => [ '*', '*' ],
+    strong => [ '*', '*' ],
+    i => [ '_', '_' ],
+    em => [ '_', '_' ],
+    p => [ '', "\n\n" ],
+    li => [ '', "\n\n" ],
+};
+sub _sanitize_elt {
+    my $elt = shift;
+    foreach ($elt->content_list) {
+        next unless ref $_;
+        $list_type = $_->tag, $list_num = 1 if $_->tag eq 'ol' || $_->tag eq 'ul';
+        _sanitize_elt($_);
+        $_->replace_with("\n") if $_->tag eq 'br';
+        $_->replace_with('[image: ', $_->attr('alt'), ']') if $_->tag eq 'img';
+        $_->replace_with($_->as_text, ' [', $_->attr('href'), ']') if $_->tag eq 'a';
+        $_->replace_with_content if $_->tag eq 'span' || $_->tag eq 'font';
+        $_->replace_with_content if $_->tag eq 'ul' || $_->tag eq 'ol';
+        if ($_->tag eq 'li') {
+            $sanitize_text_subs->{li}[0] = $list_type eq 'ol' ? "$list_num. " : '* ';
+            $list_num++;
+        }
+        if (my $sub = $sanitize_text_subs->{$_->tag}) {
+            $_->preinsert($sub->[0]);
+            $_->postinsert($sub->[1]);
+            $_->replace_with_content;
+        }
+    }
+}
+
+=head2 email_sanitize_html
+
+Intended for use in the _email_comment_list.html template to allow HTML
+in updates from staff/superusers.
+
+=cut
+
+sub email_sanitize_html : Fn('email_sanitize_html') {
+    my $update = shift;
+
+    my $text = $update->{item_text};
+    my $extra = $update->{item_extra};
+    $extra = $extra ? RABX::wire_rd(new IO::String($extra)) : {};
+
+    my $staff = $extra->{is_superuser} || $extra->{is_body_user};
+
+    return FixMyStreet::App::View::Web::_staff_html_markup($text, $staff);
+}
+
 1;
diff --git a/perllib/FixMyStreet/TestMech.pm b/perllib/FixMyStreet/TestMech.pm
index 277eca2b1..f6854fc98 100644
--- a/perllib/FixMyStreet/TestMech.pm
+++ b/perllib/FixMyStreet/TestMech.pm
@@ -276,6 +276,24 @@ sub get_text_body_from_email {
     return $body;
 }
 
+sub get_html_body_from_email {
+    my ($mech, $email, $obj) = @_;
+    unless ($email) {
+        $email = $mech->get_email;
+        $mech->clear_emails_ok;
+    }
+
+    my $body;
+    $email->walk_parts(sub {
+        my $part = shift;
+        return if $part->subparts;
+        return if $part->content_type !~ m{text/html};
+        $body = $obj ? $part : $part->body_str;
+        ok $body, "Found HTML body";
+    });
+    return $body;
+}
+
 sub get_link_from_email {
     my ($mech, $email, $multiple, $mismatch) = @_;
     unless ($email) {