Fixed development target in Makefile

The problem is that by default the test-data/config file contains
$ScriptName = 'http://localhost/wiki.pl' but morbo serves the site at
http://127.0.0.1:8080. We therefore append a new $ScriptName
assignment if the correct one doesn't exist. The alternative is
tricky because of the /wiki.pl prefix; fixing that would require a lot
more code, I suspect.

Makefile

@@ -64,6 +64,17 @@ test:
 # Spin up a quick test
 
 development:
+	@if grep --quiet 'ScriptName = "http://127.0.0.1:8080";' test-data/config; then \
+	  echo Not overwriting \$$ScriptName in test-data/config; \
+	else \
+	  echo '$ScriptName = "http://127.0.0.1:8080";' >> test-data/config; \
+	fi
 	morbo --listen http://*:8080 \
-	--watch wiki.pl --watch test-data/config --watch test-data/modules/ \
-	stuff/mojolicious-app.pl
+	  --watch wiki.pl --watch test-data/config --watch test-data/modules/ \
+	  stuff/mojolicious-app.pl
+
+%.pem:
+	openssl req -new -x509 -days 365 -nodes -out cert.pem -keyout key.pem
+
+gemini: cert.pem key.pem
+	perl stuff/gemini-server.pl --wiki_cert_file=cert.pem --wiki_key_file=key.pem

modules/creole.pl

@@ -246,7 +246,8 @@ sub CreoleRule {
             $q->img({-src=> UnquoteHtml($1),
                      -alt=> UnquoteHtml($3),
                      -title=> UnquoteHtml($3),
-                     -class=> 'url outside'})));
+		     -class=> 'url outside',
+		     -loading=>'lazy'})));
   }
   # image link: [[link|{{pic}}]] and [[link|{{pic|text}}]]
   elsif (m/\G(\[\[$FreeLinkPattern$CreoleLinkPipePattern
@@ -257,7 +258,8 @@ sub CreoleRule {
                  $q->img({-src=> GetDownloadLink(FreeToNormal($3), 2),
                           -alt=> UnquoteHtml($text),
                           -title=> UnquoteHtml($text),
-                          -class=> 'upload'}), 'image')), $text);
+                          -class=> 'upload',
+			  -loading=>'lazy'}), 'image')), $text);
   }
   # image link: [[link|{{url}}]] and [[link|{{url|text}}]]
   elsif (m/\G(\[\[$FreeLinkPattern$CreoleLinkPipePattern
@@ -268,7 +270,8 @@ sub CreoleRule {
                  $q->img({-src=> UnquoteHtml($3),
                           -alt=> UnquoteHtml($text),
                           -title=> UnquoteHtml($text),
-                          -class=> 'url outside'}), 'image')), $text);
+                          -class=> 'url outside',
+			  -loading=>'lazy'}), 'image')), $text);
   }
   # image link: [[url|{{pic}}]] and [[url|{{pic|text}}]]
   elsif (m/\G(\[\[$FullUrlPattern$CreoleLinkPipePattern
@@ -279,7 +282,8 @@ sub CreoleRule {
             $q->img({-src=> GetDownloadLink(FreeToNormal($3), 2),
                      -alt=> UnquoteHtml($text),
                      -title=> UnquoteHtml($text),
-                     -class=> 'upload'}))), $text);
+                     -class=> 'upload',
+		     -loading=>'lazy'}))), $text);
   }
   # image link: [[url|{{url}}]] and [[url|{{url|text}}]]
   elsif (m/\G\[\[$FullUrlPattern$CreoleLinkPipePattern
@@ -289,7 +293,8 @@ sub CreoleRule {
             $q->img({-src=> UnquoteHtml($2),
                      -alt=> UnquoteHtml($4),
                      -title=> UnquoteHtml($4),
-                     -class=> 'url outside'})));
+                     -class=> 'url outside',
+		     -loading=>'lazy'})));
   }
   # link: [[url]] and [[url|text]]
   elsif (m/\G\[\[$FullUrlPattern$CreoleLinkTextPattern\]\]/cgs) {

modules/ditaa.pl

@@ -43,7 +43,7 @@ sub DitaaRule {
     my $data = MIME::Base64::encode_base64($image);
     my $url = "data:image/png;base64,$data";
     return CloseHtmlEnvironments()
-      . "<div$style>" . $q->img({-src=>$url, -alt=>$map}) . "</div>";
+      . "<div$style>" . $q->img({-src=>$url, -alt=>$map, -loading=>'lazy'}) . "</div>";
   }
   return undef;
 }

modules/duckduckgo-search.pl

@@ -49,5 +49,5 @@ sub DuckDuckGoSearchInit {
 
 sub DoDuckDuckGoSearch {
   my $search = UrlEncode(GetParam('search', undef));
-  print $q->redirect({-uri=>"https://www.duckduckgo.com/?q=$search+site%3A$DuckDuckGoSearchDomain"});
+  print $q->redirect({-uri=>"https://duckduckgo.com/?q=$search+site%3A$DuckDuckGoSearchDomain"});
 }

modules/image.pl

@@ -66,7 +66,7 @@ sub ImageSupportRule {
       $src = $ImageUrlPath . '/' . ImageUrlEncode($name);
     }
     if ($found) {
-      $result = $q->img({-src=>$src, -alt=>$alt, -title=>$alt, -class=>'upload'});
+      $result = $q->img({-src=>$src, -alt=>$alt, -title=>$alt, -class=>'upload', -loading=>'lazy'});
       $result = $q->a({-href=>$link, -class=>$linkclass}, $result);
       if ($comments) {
 	for (split '\n', $comments) {

modules/portrait-support.pl

@@ -42,7 +42,7 @@ sub PortraitSupportRule {
       $PortraitSupportColorDiv = 0;
       return $html;
     } elsif ($bol && m/\Gportrait:$UrlPattern/cg) {
-      return $q->img({-src=>$1, -alt=>T("Portrait"), -class=>'portrait'});
+      return $q->img({-src=>$1, -alt=>T("Portrait"), -class=>'portrait', -loading=>'lazy'});
     } elsif ($bol && m/\G(:*)\[new(.*)\]/cg) {
       my $portrait = '';
       my $depth = length($1);

modules/static-copy.pl

@@ -100,7 +100,7 @@ sub StaticGetDownloadLink {
   return '[' . ($image ? 'image' : 'link') . ':' . $name . ']' unless $IndexHash{$id};
   if ($image) {
     return StaticFileName($id) if $image == 2;
-    my $result = $q->img({-src=>StaticFileName($id), -alt=>$alt, -class=>'upload'});
+    my $result = $q->img({-src=>StaticFileName($id), -alt=>$alt, -class=>'upload', -loading=>'lazy'});
     $result = ScriptLink($id, $result, 'image');
     return $result;
   } else {
@@ -198,7 +198,7 @@ EOT
     my $logo = $LogoUrl;
     $logo =~ s|.*/||;           # just the filename
     my $alt = T('[Home]');
-    $header .= $q->img({-src=>$logo, -alt=>$alt, -class=>'logo'}) if $logo;
+    $header .= $q->img({-src=>$logo, -alt=>$alt, -class=>'logo', -loading=>'lazy'}) if $logo;
   }
   # top toolbar
   local $UserGotoBar = '';      # only allow @UserGotoBarPages
@@ -317,7 +317,7 @@ sub GetDownloadLink {
       $action = $ScriptName . '?' . $action;
     }
     return $action if $image == 2;
-    my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload'});
+    my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload', -loading=>'lazy'});
     $result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
     return $result;
   } else {

modules/static-hybrid.pl

@@ -95,7 +95,7 @@ sub StaticGetDownloadLink {
 	# if the page does not exist
 	return '[' . ($image ? 'image' : 'link') . ':' . $name . ']' unless $IndexHash{$id};
 	if ($image) {
-		my $result = $q->img({-src=>StaticFileName($id), -alt=>$alt, -class=>'upload'});
+		my $result = $q->img({-src=>StaticFileName($id), -alt=>$alt, -class=>'upload', -loading=>'lazy'});
 		$result = ScriptLink($id, $result, 'image');
 		return $result;
 	} else {
@@ -271,7 +271,7 @@ sub GetDownloadLink {
 		} else {
 			$action = $ScriptName . '?' . $action;
 		}
-		my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload'});
+		my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload', -loading=>'lazy'});
 		$result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
 		return $result;
 	} else {

modules/tags.pl

@@ -123,7 +123,8 @@ sub TagsRule {
 			    -title=>T('Feed for this tag'),
 			    -rel=>'feed'
 			   }, $q->img({-src=>$TagFeedIcon,
-				       -alt=>T('RSS')}));
+				       -alt=>T('RSS'),
+				       -loading=>'lazy'}));
     }
     return $html;
   }

t/duckduckgo-search.t

@@ -51,4 +51,4 @@ test_page(get_page('search=alex'),
 AppendStringToFile($ConfigFile, "\$ScriptName = 'http://emacswiki.org/';\n");
 test_page(get_page('search=alex'),
 	  'Status: 302',
-	  'Location: https://www.duckduckgo.com/\?q=alex\+site%3Aemacswiki\.org');
+	  'Location: https://duckduckgo.com/\?q=alex\+site%3Aemacswiki\.org');

t/gemini-server.t

@@ -0,0 +1,340 @@
+# Copyright (C) 2017–2020  Alex Schroeder <alex@gnu.org>
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+package OddMuse;
+use strict;
+use 5.10.0;
+use Test::More;
+use IO::Socket::SSL;
+use utf8; # tests contain UTF-8 characters and it matters
+use Modern::Perl;
+use XML::RSS;
+use XML::LibXML;
+
+require './t/test.pl';
+require './stuff/gemini-server.pl';
+
+add_module('tags.pl');
+
+# enable uploads and filtering by language
+our($ConfigFile);
+AppendStringToFile($ConfigFile, <<'EOT');
+$UploadAllowed = 1;
+%Languages = (
+  'de' => '\b(der|die|das|und|oder)\b',
+  'en' => '\b(i|he|she|it|we|they|this|that|a|is|was)\b', );
+EOT
+
+# enable comments
+our($CommentsPrefix);
+$CommentsPrefix = 'Comments_on_';
+AppendStringToFile($ConfigFile, "\$CommentsPrefix = 'Comments_on_';\n");
+AppendStringToFile($ConfigFile, "\@QuestionaskerQuestions = (['Who rules in Rivendell?' => sub { shift =~ /^Elrond/i }]);\n");
+
+# write a gemini-only extension
+our($DataDir);
+WriteStringToFile("$DataDir/gemini_config", <<'EOT');
+package OddMuse;
+use Modern::Perl;
+our (@extensions, @main_menu_links);
+push(@extensions, \&serve_cert);
+sub serve_cert {
+  my $self = shift;
+  my $url = shift;
+  my $selector = shift;
+  my $base = $self->base();
+  if ($selector =~ m!^do/test!) {
+    say "20 text/plain\r";
+    say "Test";
+    return 1;
+  }
+  return;
+}
+1;
+EOT
+
+my $host = "127.0.0.1";
+my $port = random_port();
+my $pid = fork();
+
+END {
+  # kill server
+  if ($pid) {
+    kill 'KILL', $pid or warn "Could not kill server $pid";
+  }
+}
+
+if (!defined $pid) {
+  die "Cannot fork: $!";
+} elsif ($pid == 0) {
+  use Config;
+  my $secure_perl_path = $Config{perlpath};
+  exec($secure_perl_path,
+       "stuff/gemini-server.pl",
+       "--host=$host",
+       "--port=$port",
+       "--wiki_cert_file=t/cert.pem",
+       "--wiki_key_file=t/key.pem",
+       "--log_level=0", # set to 4 for verbose logging
+       "--wiki=./wiki.pl",
+       "--wiki_dir=$DataDir",
+       "--wiki_pages=Alex",
+       "--wiki_pages=Berta",
+       "--wiki_pages=Chris")
+      or die "Cannot exec: $!";
+}
+
+# Sorting
+is(sub{$a="Alex"; $b="Berta"; newest_first()}->(), -1, "Alex before Berta");
+is(sub{$a="Alex"; $b="Comments_on_Alex"; newest_first()}->(), -1, "Alex before Comments_on_Alex");
+is(sub{$a="Chris"; $b="Comments_on_Alex"; newest_first()}->(), 1, "Chris after Comments_on_A");
+is(sub{$a="Image_1_for_Alex"; $b="Image_10_for_Alex"; newest_first()}->(), -1, "Image_1_for_Alex before Image_10_for_Alex");
+is(sub{$a="Comments_on_Alex"; $b="Image_1_for_Alex"; newest_first()}->(), -1, "Comments_on_Alex before Image_1_for_Alex");
+is(join(" ", sort newest_first qw(Alex Berta Chris)), "Alex Berta Chris", "Sort alphabetically");
+is(join(" ", sort newest_first qw(2017-12-25 2017-12-26 2017-12-27)), "2017-12-27 2017-12-26 2017-12-25", "Sort by date descending");
+is(join(" ", sort newest_first qw(Alex Comments_on_Alex Berta Chris)), "Alex Comments_on_Alex Berta Chris", "Comments after pages");
+is(join(" ", sort newest_first qw(2017-12-25 2017-12-26 Comments_on_2017-12-26 2017-12-27)), "2017-12-27 2017-12-26 Comments_on_2017-12-26 2017-12-25", "Comments after date pages");
+is(join(" ", sort newest_first qw(Alex Comments_on_Alex Image_1_for_Alex Image_2_for_Alex Image_10_for_Alex Berta Chris)), "Alex Comments_on_Alex Image_1_for_Alex Image_2_for_Alex Image_10_for_Alex Berta Chris", "Images sorted numerically");
+
+update_page('Alex', "My best friend is [[Berta]].\n\nTags: [[tag:Friends]]\n");
+update_page('Berta', "This is me.\n\nTags: [[tag:Friends]]\n");
+update_page('Chris', "I'm Chris.\n\nTags: [[tag:Friends]]\n");
+update_page('Friends', "Some friends.\n");
+update_page('2017-12-25', 'It was a Monday.\n\nTags: [[tag:Day]]');
+update_page('2017-12-26', 'It was a Tuesday.\n\nTags: [[tag:Day]]');
+update_page('2017-12-27', 'It was a Wednesday.\n\nTags: [[tag:Day]]');
+update_page('Friends', "News about friends.\n", 'rewrite', 1); # minor change
+update_page('Friends', "News about friends:\n\n<journal search tag:friends>\n",
+	    'add journal tag', 1); # minor change
+
+# file created using convert NULL: test.png && base64 test.png
+update_page('Picture',
+	    "#FILE image/png\niVBORw0KGgoAAAANSUhEUgAAAAEAAAABAQAAAAA3bv"
+	    . "kkAAAACklEQVQI12NoAAAAggCB3UNq9AAAAABJRU5ErkJggg==");
+
+sub query_gemini {
+  my $query = shift;
+  my $text = shift;
+
+  # create client
+  my $socket = IO::Socket::SSL->new(
+    PeerHost => "localhost",
+    PeerService => $port,
+    SSL_cert_file => 'cert.pem',
+    SSL_key_file => 'key.pem',
+    SSL_verify_mode => SSL_VERIFY_NONE)
+      or die "Cannot construct client socket: $@";
+
+  $socket->print("$query\r\n");
+  $socket->print($text);
+
+  undef $/; # slurp
+  return <$socket>;
+}
+
+my $base = "gemini://$host:$port";
+
+# main menu
+my $page = query_gemini("$base/");
+
+for my $item(qw(Alex Berta Chris 2017-12-25 2017-12-26 2017-12-27)) {
+  like($page, qr/^=> $base\/$item $item/m, "main menu contains $item");
+}
+
+unlike($page, qr/^=> .*\/$/m, "No empty links in the menu");
+
+$page = query_gemini("$base/Alex");
+
+like($page, qr/^My best friend is Berta\.$/m, "Local free link (text)");
+like($page, qr/=> $base\/Berta Berta$/m, "Local free link (link)");
+like($page, qr/^Tags:$/m, "Tags footer");
+like($page, qr/^Tags:$/m, "Tags footer");
+like($page, qr/=> $base\/tag\/Friends Friends$/m, "Tag link");
+like($page, qr/^=> $base\/raw\/Alex Raw text$/m, "Raw text link");
+like($page, qr/^=> $base\/history\/Alex History$/m, "History");
+like($page, qr/^=> $base\/Comments_on_Alex Comments on this page$/m, "Comment link");
+
+# language tag
+$page = query_gemini("$base\/2017-12-25");
+like($page, qr/^20 text\/gemini; charset=UTF-8; lang=en\r\n/, "Result 20 with MIME type and language");
+
+# plain text
+$page = query_gemini("$base\/raw\/Alex");
+like($page, qr/^My best friend is \[\[Berta\]\]\.$/m, "Raw text");
+
+# history
+$page = query_gemini("$base/history/Friends");
+like($page, qr/^=> $base\/Friends\/1 Friends \(1\)/m, "Revision 1 is listed");
+like($page, qr/^=> $base\/Friends\/2 Friends \(2\)/m, "Revision 2 is listed");
+like($page, qr/^=> $base\/diff\/Friends\/1 Diff between revision 1 and the current one/m, "Diff 1 link");
+like($page, qr/^=> $base\/diff\/Friends\/2 Diff between revision 2 and the current one/m, "Diff 2 link");
+like($page, qr/^=> $base\/Friends Friends \(current\)/m, "Current revision is listed");
+$page = query_gemini("$base/Friends/1");
+like($page, qr/^Some friends\.$/m, "Revision 1 content");
+$page = query_gemini("$base/Friends/2");
+like($page, qr/^News about friends\.$/m, "Revision 2 content");
+
+#diffs
+$page = query_gemini("$base/diff/Friends/1");
+like($page, qr/^< Some friends\.\n-+\n> News about friends:\n> \n> <journal search tag:friends>\n$/m, "Diff 1 content");
+$page = query_gemini("$base/diff/Friends/2");
+like($page, qr/^< News about friends\.\n-+\n> News about friends:\n> \n> <journal search tag:friends>\n$/m, "Diff 1 content");
+
+# tags
+$page = query_gemini("$base\/tag\/Friends");
+like($page, qr/^This page is about the tag Friends\.$/m, "tag menu intro");
+for my $item(qw(Friends Alex Berta Chris)) {
+  like($page, qr/^=> $base\/$item $item$/m, "tag menu contains $item");
+}
+
+# tags
+$page = query_gemini("$base\/tag\/Day");
+like($page, qr/2017-12-27.*2017-12-26.*2017-12-25/s,
+     "tag menu sorted newest first");
+
+# match
+$page = query_gemini("$base\/do/match?2017");
+for my $item(qw(2017-12-25 2017-12-26 2017-12-27)) {
+  like($page, qr/^=> $base\/$item $item$/m, "match menu contains $item");
+}
+like($page, qr/2017-12-27.*2017-12-26.*2017-12-25/s,
+     "match menu sorted newest first");
+
+# search
+$page = query_gemini("$base\/do/search?tag:day");
+for my $item(qw(2017-12-25 2017-12-26 2017-12-27)) {
+  like($page, qr/^=> $base\/$item $item/m, "search menu contains $item");
+}
+like($page, qr/2017-12-27.*2017-12-26.*2017-12-25/s,
+     "search menu sorted newest first");
+
+# rc
+$page = query_gemini("$base\/do/rc");
+my $re = join(".*", "Picture", "2017-12-27", "2017-12-26", "2017-12-25",
+	      "Friends", "Chris", "Berta", "Alex");
+like($page, qr/$re/s, "rc in the right order");
+
+$page = query_gemini("$base\/do/rc/minor");
+
+$re = join(".*", "Friends", "2017-12-27", "2017-12-26", "2017-12-25");
+like($page, qr/$re/s, "minor rc in the right order");
+
+# feeds
+my $xpc = XML::LibXML::XPathContext->new;
+$xpc->registerNs('atom', 'http://www.w3.org/2005/Atom');
+
+# rss with regular pages
+my $feed = new XML::RSS;
+$page = query_gemini("$base\/do/rss");
+ok($page =~ s!^20 application/rss\+xml\r\n!!, "RSS header OK");
+ok($feed->parse($page), "RSS parse OK");
+for my $item(qw(Alex Berta Chris 2017-12-25 2017-12-26 2017-12-27)) {
+  ok(grep(/$item/, map { $_->{title} } @{$feed->{items}}), "$item found in RSS feed");
+}
+
+# atom with regular pages
+$page = query_gemini("$base\/do/atom");
+ok($page =~ s!^20 application/atom\+xml\r\n!!, "Atom header OK");
+# $feed->parse($page) results in warnings that I can't get rid of
+ok(my $doc = XML::LibXML->load_xml(string => $page), "Atom parse OK");
+for my $item(qw(Alex Berta Chris 2017-12-25 2017-12-26 2017-12-27)) {
+  ok($xpc->find("//atom:entry/atom:title[text()='$item']", $doc), "$item found in Atom feed");
+}
+
+add_module('journal-rss.pl');
+
+# rss with just the journal
+$page = query_gemini("$base\/do/rss");
+ok($page =~ s!^20 application/rss\+xml\r\n!!, "RSS header OK");
+ok($feed->parse($page), "RSS parse OK");
+for my $item(qw(2017-12-25 2017-12-26 2017-12-27)) {
+  ok(grep(/$item/, map { $_->{title} } @{$feed->{items}}), "$item found in RSS feed");
+}
+for my $item(qw(Alex Berta Chris)) {
+  ok(!grep(/$item/, map { $_->{title} } @{$feed->{items}}), "$item not found in RSS feed");
+}
+my ($sec, $min, $hour, $mday, $mon, $year, $wday) = localtime;
+$year += 1900;
+# Fri, 19 Jun 2020 20:41:55 GMT
+my $today = sprintf("%s, %02d %s %d",
+		    qw(Sun Mon Tue Wed Thu Fri Sat)[$wday], $mday,
+		    qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec)[$mon], $year);
+like($page, qr!<pubDate>$today \d\d:\d\d:\d\d GMT</pubDate>!, "Update timestamp for today");
+
+# atom with just the journal
+$page = query_gemini("$base\/do/atom");
+ok($page =~ s!^20 application/atom\+xml\r\n!!, "Atom header OK");
+# $feed->parse($page) results in warnings that I can't get rid of
+ok($doc = XML::LibXML->load_xml(string => $page), "Atom parse OK");
+for my $item(qw(2017-12-25 2017-12-26 2017-12-27)) {
+  ok($xpc->find("//atom:entry/atom:title[text()='$item']", $doc), "$item found in Atom feed");
+}
+for my $item(qw(Alex Berta Chris)) {
+  ok(!$xpc->find("//atom:entry/atom:title[text()='$item']", $doc), "$item not found in Atom feed");
+}
+$today = sprintf("%d-%02d-%02d", $year, $mon+1, $mday);
+like($page, qr!<updated>${today}T\d\d:\d\d:\d\dZ</updated>!, "Update timestamp for today");
+
+# upload text
+
+my $titan = "titan://$host:$port";
+
+my $haiku = <<EOT;
+Quiet disk ratling
+Keyboard clicking, then it stops.
+Rain falls and I think
+EOT
+
+$page = query_gemini("$titan/raw/Haiku;size=76;mime=text/plain", $haiku);
+like($page, qr/^30 $base\/Haiku\r$/, "Titan Haiku");
+
+my $haiku_re = $haiku;
+$haiku_re =~ s/\s+/ /g; # lines get wrapped
+$haiku_re =~ s/\s+$//g;
+$haiku_re = quotemeta($haiku_re);
+$page = query_gemini("$base/Haiku");
+like($page, qr/^$haiku_re/m, "Haiku saved");
+
+# comment
+
+like($page, qr/^=> $base\/Comments_on_Haiku Comments on this page$/m, "Comment page link");
+
+$page = query_gemini("$base/Comments_on_Haiku");
+like($page, qr/^=> $base\/do\/comment\/Comments_on_Haiku Leave a comment$/m, "Leave comment link");
+
+$page = query_gemini("$base/do/comment/Comments_on_Haiku");
+like($page, qr/^30 $base\/do\/comment\/Comments_on_Haiku\/0\r$/, "Redirect to a question");
+
+$page = query_gemini("$base/do/comment/Comments_on_Haiku/0");
+like($page, qr/^10 Who rules in Rivendell\?\r$/, "Ask security question");
+
+$page = query_gemini("$base/do/comment/Comments_on_Haiku/0?elrond");
+like($page, qr/^30 $base\/do\/comment\/Comments_on_Haiku\/0\/elrond\r$/, "Redirect to comment prompt");
+
+$page = query_gemini("$base/do/comment/Comments_on_Haiku/0/elrond");
+like($page, qr/^10 Comment\r$/, "Ask for comment");
+
+$page = query_gemini("$base/do/comment/Comments_on_Haiku/0/elrond?Give%20me%20the%20ring!");
+like($page, qr/^30 $base\/Comments_on_Haiku\r$/, "Redirect back to the main page");
+
+$page = query_gemini("$base/Comments_on_Haiku");
+like($page, qr/^Give me the ring!\n\n-- Anonymous/m, "Comment saved");
+
+# extension
+
+$page = query_gemini("$base/do/test");
+like($page, qr/^Test\n/m, "Extension runs");
+
+done_testing();

t/markdown-rule.t

@@ -16,7 +16,7 @@
 
 require './t/test.pl';
 package OddMuse;
-use Test::More tests => 67;
+use Test::More tests => 68;
 
 add_module('markdown-rule.pl');
 add_module('bbcode.pl');
@@ -99,6 +99,8 @@ foo\n=\nbar
 <h2>foo ##</h2>
 bar\n##foo\nbar
 bar <h2>foo</h2><p>bar</p>
+this is #foo tag
+this is #foo tag
 ```\nfoo\n```\nbar
 <pre>foo</pre><p>bar</p>
 ```\nfoo\n```

t/rc.t

@@ -51,7 +51,7 @@ test_page(get_page('action=rc raw=1'), 'title: Wiki');
 WriteStringToFile($RcFile, "1${FS}test${FS}${FS}test${FS}127.0.0.1${FS}${FS}1${FS}${FS}\n");
 test_page_negative(get_page('action=rc raw=1'), 'title: test');
 test_page(get_page('action=rc raw=1 from=1'), 'title: Wiki', 'title: test',
-	  'description: test', 'generator: Anonymous',
+	  'description: test', 'generator: \d\d\d\d',
 	  'link: http://localhost/wiki.pl/test',
 	  'last-modified: 1970-01-01T00:00Z', 'revision: 1');
 

wiki.pl

@@ -802,7 +802,7 @@ sub UrlEncode {
 
 sub UrlDecode {
   my $str = shift;
-  return decode_utf8($str) if $str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eg;
+  return decode_utf8($str) if $str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eig;
   return $str;
 }
 
@@ -1135,7 +1135,7 @@ sub GetUrl {
   }
   $url = UnquoteHtml($url); # links should be unquoted again
   if ($images and $url =~ /^(http:|https:|ftp:).+\.$ImageExtensions$/i) {
-    return $q->img({-src=>$url, -alt=>$url, -class=>$class});
+    return $q->img({-src=>$url, -alt=>$url, -class=>$class, -loading=>'lazy'});
   } else {
     return $q->a({-href=>$url, -class=>$class}, $text);
   }
@@ -1224,7 +1224,8 @@ sub GetDownloadLink {
   if ($image) {
     $action = $ScriptName . (($UsePathInfo and not $revision) ? '/' : '?') . $action;
     return $action if $image == 2;
-    my $result = $q->img({-src=>$action, -alt=>UnquoteHtml($alt), -title=>UnquoteHtml($alt), -class=>'upload'});
+    my $result = $q->img({-src=>$action, -alt=>UnquoteHtml($alt), -title=>UnquoteHtml($alt),
+			  -class=>'upload', -loading=>'lazy'});
     $result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
     return $result;
   } else {
@@ -1860,7 +1861,7 @@ sub RcTextRevision {
   $summary = GetPageContent($id) if GetParam('full', 0);
   print "\n", RcTextItem('title', NormalToFree($id)),
     RcTextItem('description', $summary),
-    RcTextItem('generator', GetAuthor($username)),
+    RcTextItem('generator', GetAuthor($username, $host)),
     RcTextItem('language', join(', ', @{$languages})), RcTextItem('link', $link),
     RcTextItem('last-modified', TimeToW3($ts)),
     RcTextItem('revision', $revision),
@@ -2216,11 +2217,16 @@ sub ScriptLinkDiff {
   return ScriptLink($action, $text, 'diff');
 }
 
-sub ColorCode {
+sub Code {
   my ($str) = @_;
   my $num = unpack("L",B::hash($str)); # 32-bit integer
   my $code = sprintf("%o", $num); # octal is 0-7
-  my @indexes = split(//, substr($code, 0, 4)); # four numbers
+  return substr($code, 0, 4); # four numbers
+}
+
+sub ColorCode {
+  my $code = Code(@_);
+  my @indexes = split(//, $code); # four numbers
   my @colors = qw/red orange yellow green blue indigo violet white/;
   return $q->span({-class => 'ip-code', -title => T('Anonymous')},
 		  join('', map { $q->span({-class => $colors[$_]}, $_) }
@@ -2228,9 +2234,10 @@ sub ColorCode {
 }
 
 sub GetAuthor {
-  my ($username) = @_;
+  my ($username, $host) = @_;
   return $username if $username;
-  return T('Anonymous');
+  return T('Anonymous') if $host eq 'Anonymous';
+  return Code($host);
 }
 
 sub GetAuthorLink {
@@ -3356,6 +3363,7 @@ sub SortIndex {
 sub DoIndex {
   my $raw = GetParam('raw', 0);
   my $match = GetParam('match', '');
+  my $limit = GetParam('n', '');
   my @pages = ();
   my @menu = ($q->label({-for=>'indexmatch'}, T('Filter:')) . ' '
 	      . $q->textfield(-name=>'match', -id=>'indexmatch', -size=>20));
@@ -3368,6 +3376,7 @@ sub DoIndex {
   }
   @pages = grep /$match/i, @pages if $match;
   @pages = sort SortIndex @pages;
+  @pages = @pages[0 .. $limit - 1] if $limit;
   if ($raw) {
     print GetHttpHeader('text/plain'); # and ignore @menu
   } else {