Compare commits

..

3 Commits

Author SHA1 Message Date
Alex Schroeder
1e223279d9 common-mark: small fixes
Down to 446 failed tests.

Fixed attribute names for HTML.
Fixed regexp for unquoted parts in HTML.
Added beginning of image link handling.
Fixed regexp for single backquote code.
2020-06-02 23:25:46 +02:00
Alex Schroeder
a69d28596f common-mark: down to 450 failed tests 2020-06-01 09:31:11 +02:00
Alex Schroeder
fb77a7a326 common-mark: down to 470 failed tests 2020-06-01 09:31:11 +02:00
54 changed files with 8474 additions and 2681 deletions

View File

@@ -3,7 +3,7 @@
# subdirectory.
VERSION_NO=$(shell git describe --tags)
TRANSLATIONS=$(wildcard modules/translations/*-utf8.pl)
TRANSLATIONS=$(wildcard modules/translations/[a-z]*-utf8.pl$)
MODULES=$(sort $(wildcard modules/*.pl))
BUILD=build/wiki.pl $(foreach file, $(notdir $(MODULES)) $(notdir $(TRANSLATIONS)), build/$(file))
@@ -64,17 +64,6 @@ 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
%.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
--watch wiki.pl --watch test-data/config --watch test-data/modules/ \
stuff/mojolicious-app.pl

View File

@@ -1,425 +0,0 @@
/*!
* LaTeX.css (https://latex.now.sh/)
*
* Source: https://github.com/vincentdoerig/latex-css
* Licensed under MIT (https://github.com/vincentdoerig/latex-css/blob/master/LICENSE)
*/
@font-face {
font-family: 'Latin Modern';
font-style: normal;
font-weight: normal;
font-display: swap;
src: url('/style/fonts/LM-regular.woff2') format('woff2'),
url('/style/fonts/LM-regular.woff') format('woff'),
url('/style/fonts/LM-regular.ttf') format('truetype');
}
@font-face {
font-family: 'Latin Modern';
font-style: italic;
font-weight: normal;
font-display: swap;
src: url('/style/fonts/LM-italic.woff2') format('woff2'),
url('/style/fonts/LM-italic.woff') format('woff'),
url('/style/fonts/LM-italic.ttf') format('truetype');
}
@font-face {
font-family: 'Latin Modern';
font-style: normal;
font-weight: bold;
font-display: swap;
src: url('/style/fonts/LM-bold.woff2') format('woff2'),
url('/style/fonts/LM-bold.woff') format('woff'),
url('/style/fonts/LM-bold.ttf') format('truetype');
}
@font-face {
font-family: 'Latin Modern';
font-style: italic;
font-weight: bold;
font-display: swap;
src: url('/style/fonts/LM-bold-italic.woff2') format('woff2'),
url('/style/fonts/LM-bold-italic.woff') format('woff'),
url('/style/fonts/LM-bold-italic.ttf') format('truetype');
}
/* Box sizing rules */
*,
*::before,
*::after {
box-sizing: border-box;
}
/* Remove default margin */
body,
h1,
h2,
h3,
h4,
p,
ul[class],
ol[class],
li,
figure,
figcaption,
dl,
dd {
margin: 0;
}
/* Make default font-size 1rem and add smooth scrolling to anchors */
html {
font-size: 1.4rem;
scroll-behavior: smooth;
}
body {
font-family: 'Latin Modern', Georgia, Cambria, 'DejaVu Serif', 'Times New Roman', Times, serif;
line-height: 1.4;
max-width: 80ch;
min-height: 100vh;
overflow-x: hidden;
margin: 0 auto;
padding: 2rem 1.25rem;
counter-reset: theorem;
counter-reset: definition;
color: hsl(0, 5%, 10%);
background-color: hsl(210, 20%, 98%);
text-rendering: optimizeLegibility;
}
/* Justify and hyphenate all paragraphs */
p {
text-align: justify;
hyphens: auto;
-webkit-hyphens: auto;
-moz-hyphens: auto;
margin-top: 1rem;
}
/* A elements that don't have a class get default styles */
a:not([class]) {
text-decoration-skip-ink: auto;
}
/* Make links red */
a {
text-decoration: none;
color: #a00;
}
a:visited {
text-decoration: none;
color: #800;
}
a:focus {
outline-offset: 2px;
outline: 2px solid hsl(220, 90%, 52%);
}
/* Ueberschriften mit Links nur dezent einfärben */
h1 a, h1 a:visited,
h2 a, h2 a:visited,
h3 a, h3 a:visited,
h4 a, h4 a:visited,
h5 a, h5 a:visited,
h6 a, h6 a:visited {
color: #555;
}
/* goto bar */
div.menu form.search {
font-size:75%;
margin-top:2em;
margin-bottom:3em;
}
div.menu span.gotobar a.local,
div.menu span.gotobar a.local:visited {
text-decoration: none;
color: #1e133c87;
margin-right:1.1em;
font-weight: bold;
}
/* Make images easier to work with */
img {
max-width: 100%;
display: block;
}
/* Inherit fonts for inputs and buttons */
input,
button,
textarea,
select {
font: inherit;
}
/* Prevent textarea from overflowing */
textarea {
width: 100%;
}
/* Natural flow and rhythm in articles by default */
article > * + * {
margin-top: 1em;
}
/* Styles for inline code or code snippets */
code,
pre,
kbd {
font-family: Menlo, Monaco, Consolas, 'Liberation Mono', 'Courier New',
monospace;
font-size: 85%;
}
pre {
padding: 1rem 1.4rem;
max-width: 100%;
overflow: auto;
border-radius: 4px;
background: hsl(210, 28%, 93%);
}
pre code {
font-size: 95%;
position: relative;
}
kbd {
background: hsl(210, 5%, 100%);
border: 1px solid hsl(210, 5%, 70%);
border-radius: 2px;
padding: 2px 4px;
font-size: 75%;
}
/* Make table 100% width, add borders between rows */
table {
border-collapse: collapse;
border-spacing: 0;
width: 100%;
max-width: 100%;
}
th,
td {
text-align: left;
padding: 0.5rem;
}
td {
border-bottom: 1px solid hsl(0, 0%, 85%);
}
thead th {
border-bottom: 2px solid hsl(0, 0%, 70%);
}
tfoot th {
border-top: 2px solid hsl(0, 0%, 70%);
}
/* Center align the title */
h1:first-child {
text-align: center;
}
/* Nested ordered list for ToC */
nav ol {
counter-reset: item;
padding-left: 2rem;
}
nav li {
display: block;
}
nav li:before {
content: counters(item, '.') ' ';
counter-increment: item;
padding-right: 0.85rem;
}
/* Center definitions (most useful for display equations) */
dl dd {
text-align: center;
}
/* Theorem */
.theorem {
counter-increment: theorem;
display: block;
margin: 12px 0;
font-style: italic;
}
.theorem::before {
content: 'Satz ' counter(theorem) '. ';
font-weight: bold;
font-style: normal;
}
/* Lemma */
.lemma {
counter-increment: theorem;
display: block;
margin: 12px 0;
font-style: italic;
}
.lemma::before {
content: 'Lemma ' counter(theorem) '. ';
font-weight: bold;
font-style: normal;
}
/* Proof */
.proof {
display: block;
margin: 12px 0;
font-style: normal;
position: relative;
}
.proof::before {
content: 'Beweis.' attr(title);
font-style: italic;
}
.proof:after {
content: '◾️';
position: absolute;
right: -12px;
bottom: -2px;
}
/* Definition */
.definition {
counter-increment: definition;
display: block;
margin: 12px 0;
font-style: normal;
}
.definition::before {
content: 'Definition ' counter(definition) '. ';
font-weight: bold;
font-style: normal;
}
/* Center align author name, use small caps and add vertical spacing */
.author {
margin: 0.85rem 0;
font-variant-caps: small-caps;
text-align: center;
}
/* Make footnote text smaller and left align it (looks bad with long URLs) */
.footnotes p {
text-align: left;
line-height: 1.5;
font-size: 85%;
margin-bottom: 0.4rem;
}
.footnotes {
border-top: 1px solid hsl(0, 0%, 39%);
}
/* Center title and paragraph */
.abstract,
.abstract p {
text-align: center;
}
.abstract {
margin: 2.25rem 0;
}
/* Format the LaTeX symbol correctly (a higher up, e lower) */
.latex span:nth-child(1) {
text-transform: uppercase;
font-size: 0.75em;
vertical-align: 0.28em;
margin-left: -0.48em;
margin-right: -0.15em;
line-height: 1ex;
}
.latex span:nth-child(2) {
text-transform: uppercase;
vertical-align: -0.5ex;
margin-left: -0.1667em;
margin-right: -0.125em;
line-height: 1ex;
}
/* Heading typography */
h1 {
font-size: 2.5rem;
line-height: 3.25rem;
margin-bottom: 1.625rem;
}
h2 {
font-size: 1.7rem;
line-height: 2rem;
margin-top: 3rem;
}
h3 {
font-size: 1.4rem;
margin-top: 2.5rem;
}
h4 {
font-size: 1.2rem;
margin-top: 2rem;
}
h5 {
font-size: 1rem;
margin-top: 1.8rem;
}
h6 {
font-size: 1rem;
font-style: italic;
font-weight: normal;
margin-top: 2.5rem;
}
h3,
h4,
h5,
h6 {
line-height: 1.625rem;
}
h1 + h2 {
margin-top: 1.625rem;
}
h2 + h3,
h3 + h4,
h4 + h5 {
margin-top: 0.8rem;
}
h5 + h6 {
margin-top: -0.8rem;
}
h2,
h3,
h4,
h5,
h6 {
margin-bottom: 0.8rem;
}
div.diff div.old {
background-color: #FFFFAF;
}
div.diff div.new {
background-color: #CFFFCF;
}
div.content blockquote {
font-style: italic;
}

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2013-2021 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2013-2016 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
@@ -96,20 +96,16 @@ sub DoBanHosts {
if (IsItBanned($_, \@regexps)) {
print $q->p(Ts("%s is banned", $name));
} else {
my @pairs = BanContributors::get_range($_);
while (@pairs) {
my $start = shift(@pairs);
my $end = shift(@pairs);
$range = "[$start - $end]";
$name .= " " . $range;
print GetFormStart(undef, 'get', 'ban'),
GetHiddenValue('action', 'ban'),
GetHiddenValue('id', $id),
GetHiddenValue('range', $range),
GetHiddenValue('regexp', BanContributors::get_regexp_ip($start, $end)),
GetHiddenValue('recent_edit', 'on'),
$q->p($name, $q->submit(T('Ban!'))), $q->end_form();
}
my ($start, $end) = BanContributors::get_range($_);
$range = "[$start - $end]";
$name .= " " . $range;
print GetFormStart(undef, 'get', 'ban'),
GetHiddenValue('action', 'ban'),
GetHiddenValue('id', $id),
GetHiddenValue('range', $range),
GetHiddenValue('regexp', BanContributors::get_regexp_ip($start, $end)),
GetHiddenValue('recent_edit', 'on'),
$q->p($name, $q->submit(T('Ban!'))), $q->end_form();
}
}
}
@@ -171,73 +167,47 @@ sub NewBanContributorsWriteRcLog {
package BanContributors;
use Net::Whois::Parser qw/parse_whois/;
use Net::IP;
sub get_range {
my $ip = shift;
my $response = parse_whois(domain => $ip);
my ($start, $end);
my $re = '(?:[0-9]{1,3}\.){3}[0-9]{1,3}';
# Just try all the keys and see whether there is a range match.
for (keys %$response) {
my @result;
$_ = $response->{$_};
for (ref eq 'ARRAY' ? @$_ : $_) {
$ip = Net::IP->new($_);
push(@result, $ip->ip, $ip->last_ip) if $ip;
}
return @result if @result;
}
# Fallback
return $ip, $ip;
my ($start, $end) = $response->{inetnum} =~ /($re) *- *($re)/;
return $start, $end;
}
sub get_groups {
my ($from, $to) = @_;
my @groups;
if ($from == $to) {
return [$from, $to];
}
# ones up to the nearest ten
if ($from < $to and ($from % 10 or $from < 10)) {
# from 5-7: as is
# from 5-17: 5 + 9 - 5 = 9 thus 5-9, set $from to 10
my $to2 = int($to/10) > int($from/10) ? $from + 9 - $from % 10 : $to;
push(@groups, [$from, $to2]);
$from = $to2 + 1;
}
# tens up to the nearest hundred
if ($from < $to and $from % 100) {
# 10-17: as is
# 10-82: 10 to 79, set $from to 80 (8*10-1)
# 10-182: 10 to 99, set $from to 100 (10+99=10=99)
# 110-182: 110 to 179, set $from to 180 (170)
# 110-222: 110 to 199, set $from to 200 (110+99-10 = 199)
my $to2 = int($to/100) > int($from/100) ? $from + 99 - $from % 100
: int($to/10) > int($from/10) ? int($to / 10) * 10 - 1
: $to;
push(@groups, [$from, $to2]);
$from = $to2 + 1;
}
# up to the next hundred
if (int($to/100) > int($from/100)) {
# from 100 to 223: set $from to 200 (2*100-1)
my $to2 = int($to/100) * 100 - 1;
push(@groups, [$from, $to2]);
$from = $to2 + 1;
}
# up to the next ten
if (int($to/10) > int($from/10)) {
# 10 to 17: skip
# 100 to 143: set $from to 140 (14*10-1)
my $to2 = int($to / 10) * 10 - 1;
push(@groups, [$from, $to2]);
$from = $to2 + 1;
}
# up to the next one
if ($from <= $to) {
if ($from < 10) {
my $to = $to >= 10 ? 9 : $to;
push(@groups, [$from, $to]);
$from = $to + 1;
}
while ($from < $to) {
my $to = int($from/100) < int($to/100) ? $from + 99 - $from % 100 : $to;
if ($from % 10) {
push(@groups, [$from, $from + 9 - $from % 10]);
$from += 10 - $from % 10;
}
if (int($from/10) < int($to/10)) {
if ($to % 10 == 9) {
push(@groups, [$from, $to]);
$from = 1 + $to;
} else {
push(@groups, [$from, $to - 1 - $to % 10]);
$from = $to - $to % 10;
}
} else {
push(@groups, [$from - $from % 10, $to]);
last;
}
if ($to % 10 != 9) {
push(@groups, [$from, $to]);
$from = 1 + $to; # jump from 99 to 100
}
}
# warn join("; ", map { "@$_" } @groups);
return \@groups;
}
@@ -265,42 +235,24 @@ sub get_regexp_ip {
my $regexp = "^";
for my $i (0 .. 3) {
if ($start[$i] eq $end[$i]) {
# if the byte is the same, use it as is
$regexp .= $start[$i];
$regexp .= '\.' if $i < 3;
} elsif ($start[$i] == 0 and $end[$i] == 255) {
# the starting byte is 0 and the end byte is 255, then anything goes:
# we're done, e.g. 185.244.214.0 - 185.244.214.255 results in 185\.244\.214\.
} elsif ($start[$i] eq '0' and $end[$i] eq '255') {
last;
} elsif ($i == 3 and $start[$i] != $end[$i]) {
# example 45.87.2.128 - 45.87.2.255: the last bytes differ
$regexp .= '(' . get_regexp_range($start[$i], $end[$i]) . ')';
last;
} elsif ($start[$i + 1] == 0 and $end[$i + 1] == 255) {
# if we're here, we already know that the start byte and the end byte are
# not the same; if the next bytes are from 0 to 255, we know that
# everything else doesn't matter, e.g. 42.118.48.0 - 42.118.63.255
$regexp .= '(' . get_regexp_range($start[$i], $end[$i]) . ')';
$regexp .= '\.' if $i < 3;
last;
} elsif ($end[$i] - $start[$i] == 1 and $start[$i + 1] > 0 and $end[$i + 1] < 255) {
# if we're here, we already know that the start byte and the end byte are
# not the same; if the starting byte of the next (!) byte is bigger than
# zero, then we need groups: in the case 77.56.180.0 - 77.57.70.255 for
# example,
$regexp .= '(' . $start[$i] . '\.(' . get_regexp_range($start[$i + 1], 255) . ')|'
. $end[$i] . '\.(' . get_regexp_range(0, $end[$i + 1]) . ')';
$regexp .= '\.' if $i < 3;
} elsif ($start[$i + 1] > 0) {
$regexp .= '(' . $start[$i] . '\.('
. get_regexp_range($start[$i + 1], '255') . ')|'
. get_regexp_range($start[$i] + 1, $end[$i + 1]) . ')';
$regexp .= '\.';
last;
} else {
warn "Unhandled regexp: $from - $to ($i)";
$regexp .= 'XXX';
$regexp .= '\.' if $i < 3;
$regexp .= '(' . get_regexp_range($start[$i], $end[$i]) . ')$';
last;
}
$regexp .= '\.' if $i < 3;
}
return $regexp;
}
# this is required in case we concatenate other modules to this one
package OddMuse;

View File

@@ -64,11 +64,13 @@ sub RegexpNewBannedContent {
my $str = shift;
# check whether Banned Content complains
my $rule = RegexpOldBannedContent($str, @_);
# remove URLs as they have been checked by $BannedContent
$str =~ s/$FullUrlPattern//g;
if (not $rule) {
foreach (split(/\n/, GetPageContent($BannedRegexps))) {
next unless m/^\s*([^#]+?)\s*(#\s*(\d\d\d\d-\d\d-\d\d\s*)?(.*))?$/;
my ($regexp, $comment, $re) = ($1, $4, undef);
eval { $re = qr/($regexp)/i; };
eval { $re = qr/$regexp/i; };
if (defined($re) && $str =~ $re) {
my $group1 = $1;
my $explanation = ($group1

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20042023 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2004, 2005, 2006 Alex Schroeder <alex@emacswiki.org>
# Copyright (C) 2006 Ingo Belka
#
# This program is free software; you can redistribute it and/or modify
@@ -112,7 +112,9 @@ sub DoCollect {
my $search = GetParam('search', '');
ReportError(T('The match parameter is missing.')) unless $match or $search;
print GetHeader('', Ts('Page Collection for %s', $match||$search), '');
my @pages = Matched($match, $search ? SearchTitleAndBody($search) : AllPagesList());
my @pages = (grep(/$match/, $search
? SearchTitleAndBody($search)
: AllPagesList()));
if (!$CollectingJournal) {
$CollectingJournal = 1;
# Now save information required for saving the cache of the current page.

2627
modules/common-markdown.pl Normal file

File diff suppressed because it is too large Load Diff

View File

@@ -1,66 +0,0 @@
# Copyright (C) 2021 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/>.
use strict;
use v5.10;
AddModuleDescription('cook-lang.pl', 'Cooklang Extension');
our ($q, $bol, @MyRules);
push(@MyRules, \&CookLangRule);
sub CookLangRule {
if (/\G#([^\n#\@\{\}]+)\{(?:([^\n%\}]+)(?:%([^\n\}]+))?)?\}/cg) {
# #canning funnel{}
my $html = "";
$html .= $q->strong({-title=>"number"}, $2) if $2;
$html .= " " if $2 and $3;
$html .= $q->strong({-title=>"unit"}, $3) if $3;
$html .= " " if $1 and ($2 or $3);
$html .= $q->strong({-title=>"cookware"}, $1);
return $html;
} elsif (/\G#(\w+)/cg) {
# #pot
return $q->strong({-title=>"cookware"}, $1);
} elsif (/\G\@([^\n#\@\{\}]+)\{(?:([^\n%\}]+)(?:%([^\n\}]+))?)?\}/cg) {
# @ground black pepper{}
my $html = "";
$html .= $q->strong({-title=>"number"}, $2) if $2;
$html .= " " if $2 and $3;
$html .= $q->strong({-title=>"unit"}, $3) if $3;
$html .= " " if $1 and ($2 or $3);
$html .= $q->strong({-title=>"ingredient"}, $1);
return $html;
} elsif (/\G\@(\w+)/cg) {
# @salt
return $q->strong({-title=>"ingredient"}, $1);
} elsif (/\G\~\{([^\n%\}]+)(?:%([^\n\}]+))?\}/cg) {
# ~{25%minutes}
my $html = $q->strong({-title=>"number"}, $1);
$html .= " " if $1 and $2;
$html .= $q->strong({-title=>"unit"}, $2) if $2;
return $html;
} elsif (/\G\/\/\s*(.*)/cg) {
# // Don't burn the roux!
return $q->em({-title=>"comment"}, $1);
} elsif ($bol and /\G&gt;&gt;\s*(.*)/cg) {
# // Don't burn the roux!
return CloseHtmlEnvironments()
. $q->blockquote({-title=>"meta"}, $1)
. AddHtmlEnvironment('p');
}
# no match
return;
}

View File

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

View File

@@ -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, -loading=>'lazy'}) . "</div>";
. "<div$style>" . $q->img({-src=>$url, -alt=>$map}) . "</div>";
}
return undef;
}

View File

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

View File

@@ -48,7 +48,7 @@ sub EmojiRule {
} elsif (/\G&gt;:-?\(/cg) {
# 😠 1F620 ANGRY FACE
return '&#x1F620;';
} elsif (/\G:-?[Ppb]\b/cg) {
} elsif (/\G:-?[Ppb]/cg) {
# 😝 1F61D FACE WITH STUCK-OUT TONGUE AND TIGHTLY-CLOSED EYES
return '&#x1F61D;';
} elsif (/\G&lt;3/cg) {

View File

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

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20042023 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2004, 2007 Alex Schroeder <alex@emacswiki.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
@@ -47,5 +47,8 @@ sub PrintableIndexPages {
push(@pages, AllPagesList()) if GetParam('pages', 1);
push(@pages, keys %PermanentAnchors) if GetParam('permanentanchors', 1);
push(@pages, keys %NearSource) if GetParam('near', 0);
return sort Matched(GetParam('match'), @pages);
my $match = GetParam('match', '');
@pages = grep /$match/i, @pages if $match;
@pages = sort @pages;
return @pages;
}

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20042023 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20042018 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
@@ -18,8 +18,7 @@ use v5.10;
AddModuleDescription('journal-rss.pl', 'Journal RSS Extension');
our ($OpenPageName, $CollectingJournal, %Page, %Action, @MyInitVariables, $DeletedPage, %NearLinksException,
$RecentLink, $SiteName, $SiteDescription, $ScriptName, $RssRights);
our ($OpenPageName, $CollectingJournal, %Page, %Action, @MyInitVariables, $DeletedPage, %NearLinksException);
$Action{journal} = \&DoJournalRss;
# Currently RSS works like RecentChanges, which is not what bloggers
@@ -31,20 +30,11 @@ sub DoJournalRss {
local $CollectingJournal = 1;
# Fake the result of GetRcLines()
local *GetRcLines = \&JournalRssGetRcLines;
local *RcSelfWebsite = \&JournalRssSelfWebsite;
local *RcSelfAction = \&JournalRssSelfAction;
local *RcPreviousAction = \&JournalRssPreviousAction;
local *RcLastAction = \&JournalRssLastAction;
SetParam('full', 1);
if (GetParam('raw', 0)) {
print GetHttpHeader('text/plain');
print RcTextItem('title', $SiteName),
RcTextItem('description', $SiteDescription), RcTextItem('link', $ScriptName),
RcTextItem('generator', 'Oddmuse'), RcTextItem('rights', $RssRights);
ProcessRcLines(sub {}, \&RcTextRevision);
} else {
print GetHttpHeader('application/xml') . GetRcRss();
}
print GetHttpHeader('application/xml') . GetRcRss();
}
sub JournalRssParameters {
@@ -56,15 +46,6 @@ sub JournalRssParameters {
return $more;
}
sub JournalRssSelfWebsite {
my $more = '';
my $search = GetParam('rcfilteronly', '');
$more .= ";search=" . UrlEncode($search) if $search;
my $match = GetParam('match', '');
$more .= ";match=" . UrlEncode($match) if $match;
return $more;
}
sub JournalRssSelfAction {
return "action=journal" . JournalRssParameters(qw(offset));
}
@@ -86,7 +67,7 @@ sub JournalRssGetRcLines {
my $reverse = GetParam('reverse', 0);
my $monthly = GetParam('monthly', 0);
my $offset = GetParam('offset', 0);
my @pages = sort JournalSort (Matched($match, $search ? SearchTitleAndBody($search) : AllPagesList()));
my @pages = sort JournalSort (grep(/$match/, $search ? SearchTitleAndBody($search) : AllPagesList()));
if ($monthly and not $match) {
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday) = gmtime();
$match = '^' . sprintf("%04d-%02d", $year+1900, $mon+1) . '-\d\d';

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20092022 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20092020 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2015 Aleks-Daniel Jakimenko <alex.jakimenko@gmail.com>
#
# This program is free software; you can redistribute it and/or modify it under
@@ -505,9 +505,9 @@ sub MailUnsubscribe {
=head1 Migrate
The mailmigrate action will migrate your subscription list from the old format
to the new format. This is necessary because these days the keys and values of
the DB_File are URL encoded.
The mailmigrate action will migrate your subscription list from the
old format to the new format. This is necessary because these days
because the keys and values of the DB_File are URL encoded.
=cut

View File

@@ -1,5 +1,5 @@
#! /usr/bin/perl
# Copyright (C) 20142022 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20142019 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
@@ -194,20 +194,12 @@ sub MarkdownRule {
return OpenHtmlEnvironment('pre',1) . $str; # always level 1
}
# link: [an example](http://example.com/ "Title")
elsif (m/\G\[((?:[^]\n]+\n?)+)\]\((\S+)(\s+"(.+?)")?\)/cg) {
elsif (m/\G\[((?:[^]\n]+\n?)+)\]\($FullUrlPattern(\s+"(.+?)")?\)/cg) {
my ($text, $url, $title) = ($1, $2, $4);
$url =~ /^($UrlProtocols)/;
my %params;
$params{-href} = $url;
$params{-class} = "url";
$params{-title} = $title if $title;
return $q->a(\%params, $text);
}
# link: [an example](#foo "Title")
elsif (m/\G\[((?:[^]\n]+\n?)+)\]\((#\S)+(\s+"(.+?)")?\)/cg) {
my ($text, $url, $title) = ($1, $2, $4);
my %params;
$params{-href} = $url;
$params{-class} = "named-anchor";
$params{-class} = "url $1";
$params{-title} = $title if $title;
return $q->a(\%params, $text);
}

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20042022 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2012 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
@@ -42,18 +42,10 @@ AddModuleDescription('namespaces.pl', 'Namespaces Extension');
use File::Glob ':glob';
our ($q, %Action, %Page, @IndexList, $Now, %InterSite, $SiteName, $ScriptName,
$UsePathInfo, $DataDir, $HomePage, @MyInitVariables, @MyAdminCode, $FullUrl,
$LinkPattern, $InterSitePattern, $FreeLinks, $FreeLinkPattern,
$InterLinkPattern, $FreeInterLinkPattern, $UrlProtocols, $WikiLinks, $FS,
$BannedContent, $BannedHosts, $RcFile, $RcOldFile, $RcDefault, $PageDir,
$KeepDir, $LockDir, $TempDir, $IndexFile, $VisitorFile, $NoEditFile,
$WikiDescription, $LastUpdate, $StaticDir, $StaticUrl, $InterWikiMoniker,
$RefererDir, $PermanentAnchorsFile, @IndexList, %IndexHash);
our ($q, %Action, %Page, @IndexList, $Now, %InterSite, $SiteName, $ScriptName, $UsePathInfo, $DataDir, $HomePage, @MyInitVariables, @MyAdminCode, $FullUrl, $LinkPattern, $InterSitePattern, $FreeLinks, $FreeLinkPattern, $InterLinkPattern, $FreeInterLinkPattern, $UrlProtocols, $WikiLinks, $FS, $RcFile, $RcOldFile, $RcDefault, $PageDir, $KeepDir, $LockDir, $TempDir, $IndexFile, $VisitorFile, $NoEditFile, $WikiDescription, $LastUpdate, $StaticDir, $StaticUrl, $InterWikiMoniker, $RefererDir, $PermanentAnchorsFile);
our ($NamespacesMain, $NamespacesSelf, $NamespaceCurrent,
$NamespaceRoot, $NamespaceSlashing, @NamespaceParameters,
%Namespaces, $NamespacesRootDataDir);
$NamespaceRoot, $NamespaceSlashing, @NamespaceParameters,
%Namespaces);
$NamespacesMain = 'Main'; # to get back to the main namespace
$NamespacesSelf = 'Self'; # for your own namespace
@@ -118,7 +110,6 @@ sub NamespacesInitVariables {
}
}
$NamespaceRoot = $ScriptName; # $ScriptName may be changed below
$NamespacesRootDataDir = $DataDir; # $DataDir may be chanegd below
$NamespaceCurrent = '';
my $ns = GetNamespace();
if ($ns
@@ -126,7 +117,7 @@ sub NamespacesInitVariables {
and $ns ne $NamespacesSelf) {
$NamespaceCurrent = $ns;
# Change some stuff from the original InitVariables call:
$SiteName .= ' ' . NormalToFree($NamespaceCurrent);
$SiteName .= ' ' . $NamespaceCurrent;
$InterWikiMoniker = $NamespaceCurrent;
$DataDir .= '/' . $NamespaceCurrent;
$PageDir = "$DataDir/page";
@@ -171,56 +162,6 @@ sub NamespaceRequiredByParameter {
}
}
=head Spam fighting
We want to share C<BannedContent> and C<BannedHosts> between all the wiki
namespaces. Therefore, we need to handle a number of cases:
C<UserIsBanned> uses C<GetPageContent($BannedHosts)> and C<BannedContent> uses
C<GetPageContent($BannedContent)>, therefore C<GetPageContent> is going to get
modified.
C<DoBanHosts> in F<ban-contributors.pl> uses C<DoPost($BannedContent)> and
C<DoPost($BannedHosts)>, therefore C<DoPost> is going to get modified.
=cut
*OldNamespaceGetPageContent = \&GetPageContent;
*GetPageContent = \&NewNamespaceGetPageContent;
sub NewNamespaceGetPageContent {
my ($id) = @_;
if ($NamespaceCurrent and ($id eq $BannedContent or $id eq $BannedHosts)) {
local $PageDir = "$NamespacesRootDataDir/page";
# we cannot use ReadFileOrDie because our $IndexHash{$id} does not reflect the existence of the root file
my ($status, $data) = ReadFile(GetPageFile($id));
return ParseData($data)->{text} if $status;
return '';
}
return OldNamespaceGetPageContent(@_);
}
*OldNamespaceDoPost = \&DoPost;
*DoPost = \&NewNamespaceDoPost;
sub NewNamespaceDoPost {
my ($id) = @_;
if ($NamespaceCurrent and ($id eq $BannedContent or $id eq $BannedHosts)) {
local $DataDir = $NamespacesRootDataDir;
local $PageDir = "$DataDir/page";
local $KeepDir = "$DataDir/keep";
local $LockDir = "$TempDir/lock";
local $NoEditFile = "$DataDir/noedit";
local $RcFile = "$DataDir/rc.log";
local $RcOldFile = "$DataDir/oldrc.log";
local $IndexFile = "$DataDir/pageidx";
@IndexList = %IndexHash = ();
AllPagesList(); # reload from new pageidx
return OldNamespaceDoPost(@_);
}
return OldNamespaceDoPost(@_);
}
=head2 RecentChanges
RecentChanges in the main namespace will list changes to all the

View File

@@ -1,198 +0,0 @@
# -*- mode: perl -*-
# Copyright (C) 2023 Alex Schroeder <alex@gnu.org>
# This program is free software: you can redistribute it and/or modify it under
# the terms of the GNU Affero 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 Affero General Public License for more
# details.
#
# You should have received a copy of the GNU Affero General Public License along
# with this program. If not, see <https://www.gnu.org/licenses/>.
=encoding utf8
=head1 NAME
Oddmuse Network Blocker
=head1 DESCRIPTION
This module hooks into regular Oddmuse Surge Protection. It adds the following
features:
Repeated offenders are blocked for increasingly longer times.
For every offender, we record the CIDR their IP number belongs to. Everytime an
IP number is blocked, all the CIDRs of the other blocked IPs are checked: if
there are three or more blocked IP numbers sharing the same CIDRs, the CIDR
itself is blocked.
CIDR blocking works the same way: Repeated offenders are blocked for
increasingly longer times.
=head2 Behind a reverse proxy
Make sure your config file copies the IP number to the correct environment
variable:
$ENV{REMOTE_ADDR} = $ENV{HTTP_X_FORWARDED_FOR};
=head1 SEE ALSO
<Oddmuse Surge Protection|https://oddmuse.org/wiki/Surge_Protection>
=cut
use strict;
use v5.10;
use Net::IP qw(:PROC);
use Net::DNS qw(rr);
AddModuleDescription('network-blocker.pl', 'Network Blocker Extension');
our ($Now, $DataDir, $SurgeProtectionViews, $SurgeProtectionTime);
{
no warnings 'redefine';
*OldNetworkBlockerDelayRequired = \&DelayRequired;
*DelayRequired = \&NewNetworkBlockerDelayRequired;
}
# Block for at least this many seconds.
my $NetworkBlockerMinimumPeriod = 30;
# Every violation doubles the current period until this maximum is reached (four weeks).
my $NetworkBlockerMaximumPeriod = 60 * 60 * 24 * 7 * 4;
# All the blocked networks. Maps CIDR to an array [expiry timestamp, expiry
# period].
my %NetworkBlockerList;
# Candidates are remembered for this many seconds.
my $NetworkBlockerCachePeriod = 600;
# All the candidate networks for a block. Maps IP to an array [ts, cidr, ...].
# Candidates are removed after $NetworkBlockerCachePeriod.
my %NetworkBlockerCandidates;
sub NetworkBlockerRead {
my ($status, $data) = ReadFile("$DataDir/network-blocks");
return unless $status;
my @lines = split(/\n/, $data);
while ($_ = shift(@lines)) {
my @items = split(/,/);
$NetworkBlockerList{shift(@items)} = \@items;
}
# an empty line separates the two sections
while ($_ = shift(@lines)) {
my @items = split(/,/);
$NetworkBlockerCandidates{shift(@items)} = \@items;
}
return 1;
}
sub NetworkBlockerWrite {
RequestLockDir('network-blocks') or return '';
WriteStringToFile(
"$DataDir/network-blocks",
join("\n\n",
join("\n", map {
join(",", $_, @{$NetworkBlockerList{$_}})
} keys %NetworkBlockerList),
join("\n", map {
join(",", $_, @{$NetworkBlockerCandidates{$_}})
} keys %NetworkBlockerCandidates)));
ReleaseLockDir('network-blocks');
}
sub NewNetworkBlockerDelayRequired {
my $ip = shift;
# If $ip is a name and not an IP number, parsing fails. In this case, run the
# regular code.
my $ob = new Net::IP($ip);
return OldNetworkBlockerDelayRequired($ip) unless $ob;
# Read the file. If the file does not exist, no problem.
NetworkBlockerRead();
# See if the current IP number is one of the blocked CIDR ranges.
for my $cidr (keys %NetworkBlockerList) {
# Perhaps this CIDR block can be expired.
if ($NetworkBlockerList{$cidr}->[0] < $Now) {
delete $NetworkBlockerList{$cidr};
next;
}
# Forget the CIDR if it cannot be turned into a range.
my $range = new Net::IP($cidr);
if (not $range) {
warn "CIDR $cidr is blocked but has no range: " . Net::IP::Error();
delete $NetworkBlockerList{$cidr};
next;
}
# If the CIDR overlaps with the remote IP number, it's a block.
warn "Checking whether $ip is in $cidr\n";
my $overlap = $range->overlaps($ob);
# $IP_PARTIAL_OVERLAP (ranges overlap) $IP_NO_OVERLAP (no overlap)
# $IP_A_IN_B_OVERLAP (range2 contains range1) $IP_B_IN_A_OVERLAP (range1
# contains range2) $IP_IDENTICAL (ranges are identical) undef (problem)
if (defined $overlap and $overlap != $IP_NO_OVERLAP) {
# Double the block period unless it has reached $NetworkBlockerMaximumPeriod.
if ($NetworkBlockerList{$cidr}->[1] < $NetworkBlockerMaximumPeriod / 2) {
$NetworkBlockerList{$cidr}->[1] *= 2;
} else {
$NetworkBlockerList{$cidr}->[1] = $NetworkBlockerMaximumPeriod;
}
$NetworkBlockerList{$cidr}->[0] = $Now + $NetworkBlockerList{$cidr}->[1];
# And we're done!
NetworkBlockerWrite();
ReportError(Ts('Too many connections by %s', $cidr)
. ': ' . Tss('Please do not fetch more than %1 pages in %2 seconds.',
$SurgeProtectionViews, $SurgeProtectionTime),
'503 SERVICE UNAVAILABLE');
}
}
# If the CIDR isn't blocked, let's see if Surge Protection wants to block it.
my $result = OldNetworkBlockerDelayRequired($ip);
warn "$ip was blocked\n" if $result;
# If the IP is to be blocked, determine its CIDRs and put them on a list. Sadly,
# routeviews does not support IPv6 at the moment!
if ($result and not ip_is_ipv6($ip) and not $NetworkBlockerCandidates{$ip}) {
my $reverse = $ob->reverse_ip();
$reverse =~ s/in-addr\.arpa\.$/asn.routeviews.org/;
my @candidates;
for my $rr (rr($reverse, "TXT")) {
next unless $rr->type eq "TXT";
my @data = $rr->txtdata;
push(@candidates, join("/", @data[1..2]));
}
warn "$ip is in @candidates\n";
$NetworkBlockerCandidates{$ip} = [$Now, @candidates];
# Expire any of the other candidates
for my $other_ip (keys %NetworkBlockerCandidates) {
if ($NetworkBlockerCandidates{$other_ip}->[0] < $Now - $NetworkBlockerCachePeriod) {
delete $NetworkBlockerCandidates{$other_ip};
}
}
# Determine if any of the CIDRs is to be blocked.
my $save;
for my $cidr (@candidates) {
# Count how often the candidate CIDRs show up for other IP numbers.
my $count = 0;
for my $other_ip (keys %NetworkBlockerCandidates) {
my @data = $NetworkBlockerCandidates{$other_ip};
for my $other_cidr (@data[1 .. $#data]) {
$count++ if $cidr eq $other_cidr;
}
}
if ($count >= 3) {
$NetworkBlockerList{$cidr} = [$Now + $NetworkBlockerMinimumPeriod, $NetworkBlockerMinimumPeriod];
$save = 1;
}
}
NetworkBlockerWrite() if $save;
}
return $result;
}

View File

@@ -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', -loading=>'lazy'});
return $q->img({-src=>$1, -alt=>T("Portrait"), -class=>'portrait'});
} elsif ($bol && m/\G(:*)\[new(.*)\]/cg) {
my $portrait = '';
my $depth = length($1);

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20192023 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2019 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
@@ -65,7 +65,6 @@ sub RenamePageMenu {
. GetHiddenValue('id', $id)
. $q->textfield(-name=>'to', -size=>20)
. ' '
. $q->submit('Do it')
. $q->end_form());
. $q->submit('Do it'));
}
}

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20062023 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2006, 2007, 2008 Alex Schroeder <alex@emacswiki.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
@@ -36,12 +36,18 @@ sub SearchListRule {
$term = GetId();
}
local ($OpenPageName, %Page);
my @found;
my %hash = ();
if ($variation eq 'list') {
@found = grep { $_ ne $original } SearchTitleAndBody($term);
} elsif ($variation eq 'titlelist') {
@found = grep { $_ ne $original } Matched($term, AllPagesList());
foreach my $id (SearchTitleAndBody($term)) {
$hash{$id} = 1 unless $id eq $original; # skip the page with the query
}
}
if ($variation eq 'titlelist') {
foreach my $id (grep(/$term/, AllPagesList())) {
$hash{$id} = 1 unless $id eq $original; # skip the page with the query
}
}
my @found = keys %hash;
if (defined &PageSort) {
@found = sort PageSort @found;
} else {
@@ -57,24 +63,32 @@ sub SearchListRule {
return;
}
# Add a new action list
$Action{list} = \&DoList;
sub DoList {
my $id = shift;
my $match = GetParam('match', '');
my $search = GetParam('search', '');
my $id = shift;
my $match = GetParam('match', '');
my $search = GetParam('search', '');
ReportError(T('The search parameter is missing.')) unless $match or $search;
print GetHeader('', Ts('Page list for %s', $match||$search), '');
local (%Page, $OpenPageName);
my @found = Matched($match, $search ? SearchTitleAndBody($search) : AllPagesList());
if (defined &PageSort) {
@found = sort PageSort @found;
} else {
@found = sort(@found);
}
@found = map { $q->li(GetPageLink($_)) } @found;
print $q->start_div({-class=>'search list'}), $q->ul(@found), $q->end_div;
my %hash = ();
foreach my $id (grep(/$match/, $search
? SearchTitleAndBody($search)
: AllPagesList())) {
$hash{$id} = 1;
}
my @found = keys %hash;
if (defined &PageSort) {
@found = sort PageSort @found;
} else {
@found = sort(@found);
}
@found = map { $q->li(GetPageLink($_)) } @found;
print $q->start_div({-class=>'search list'}),
$q->ul(@found), $q->end_div;
PrintFooter();
}

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20072023 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20072014 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
@@ -36,7 +36,8 @@ sub SisterPages {
push(@pages, AllPagesList()) if GetParam('pages', 1);
push(@pages, keys %PermanentAnchors) if GetParam('permanentanchors', 1);
push(@pages, keys %NearSource) if GetParam('near', 0);
@pages = Matched(GetParam('match', ''), @pages);
my $match = GetParam('match', '');
@pages = grep /$match/i, @pages if $match;
@pages = sort @pages;
return @pages;
}

View File

@@ -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', -loading=>'lazy'});
my $result = $q->img({-src=>StaticFileName($id), -alt=>$alt, -class=>'upload'});
$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', -loading=>'lazy'}) if $logo;
$header .= $q->img({-src=>$logo, -alt=>$alt, -class=>'logo'}) 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', -loading=>'lazy'});
my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload'});
$result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
return $result;
} else {

View File

@@ -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', -loading=>'lazy'});
my $result = $q->img({-src=>StaticFileName($id), -alt=>$alt, -class=>'upload'});
$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', -loading=>'lazy'});
my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload'});
$result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
return $result;
} else {

View File

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

View File

@@ -49,7 +49,7 @@ Le nom dutilisateur ne doit pas dépasser 50 caractères : non sauvegardé
This page contains an uploaded file:
Cette page contient un fichier téléversé :
No summary was provided for this file.
Aucun résumé fourni pour ce fichier.
Recursive include of %s!
Inclusion par récursivité de %s !
Clear Cache
@@ -95,13 +95,13 @@ Page non valide %s (ne doit pas se terminer par .lck)
Invalid Page %s
Page non valide %s
There are no comments, yet. Be the first to leave a comment!
Pas encore de commentaires. Soyez le premier à laisser un commentaire !
Welcome!
Bienvenue !
This page does not exist, but you can %s.
Cette page nexiste pas, mais vous pouvez %s.
create it now
la créer maintenant
Too many redirections
Trop de redirections
No redirection for old revisions
@@ -113,7 +113,7 @@ SVP allez à %s.
Updates since %s
Mises à jour depuis %s
up to %s
jusquà %s
jusquà
Updates in the last %s days
Mises à jour durant les derniers %s jours
Updates in the last day
@@ -133,7 +133,7 @@ Lister seulement les modifications majeures
Include minor changes
Inclure les modifications mineures
days
jours
List later changes
Lister les modifications plus récentes
RSS
@@ -263,9 +263,9 @@ par %s
(diff)
(diff)
a
a
c
c
Edit revision %s of this page
Modifier la version %s de cette page
e
@@ -409,13 +409,13 @@ Vous êtes actuellement éditeur de ce site.
You are a normal user on this site.
Vous êtes un utilisateur normal de ce site.
You do not have a password set.
Vous navez pas défini de mot de passe.
Your password does not match any of the administrator or editor passwords.
Vote mot de passe ne correspond ni au mot de passe administrateur ni au mot de passe éditeur.
Password:
Mot de passe :
Return to %s
Retour à %s
This operation is restricted to site editors only...
Cette opération est réservée aux éditeurs du site seulement...
This operation is restricted to administrators only...
@@ -445,7 +445,7 @@ Raison inconnue.
%s pages found.
%s pages trouvées.
Preview: %s
Prévisualiser: %s
Replaced: %s
Remplacé(e) : %s
Search for: %s
@@ -544,7 +544,7 @@ Deleted %s
Renaming %1 to %2.
Renomme %1 en %2.
The page %s does not exist
La page %s nexiste pas
La page %s n'existe pas
The page %s already exists
La page %s existe déjà
Cannot rename %1 to %2
@@ -563,9 +563,9 @@ Renommer %s en :
# modules/advanced-uploads.pl
################################################################################
Attach file:
Joindre un fichier:
Upload
Uploader
################################################################################
# modules/aggregate.pl
################################################################################
@@ -609,7 +609,7 @@ Ban Contributors to %s
Ban!
Regular expression:
Expression régulière :
%s is banned
These URLs were rolled back. Perhaps you want to add a regular expression to %s?
@@ -620,9 +620,9 @@ Consider banning the IP number as well:
# modules/banned-regexps.pl
################################################################################
Regular expression "%1" matched "%2" on this page.
Expression régulière "%1" correspond à "%2" sur cette page.
Regular expression "%s" matched on this page.
Expression régulière "%s" correspond à cette page.
################################################################################
# modules/big-brother.pl
################################################################################
@@ -724,7 +724,7 @@ Une expression régulière manque au tag de compilation.
# modules/creationdate.pl
################################################################################
Add creation date to page files
Ajouter une date de création aux fichiers des pages
################################################################################
# modules/css-install.pl
################################################################################
@@ -733,7 +733,7 @@ Installer CSS
Copy one of the following stylesheets to %s:
Copier une des feuilles de style suivantes sur %s.
Reset
Réinitialiser
################################################################################
# modules/dates.pl
################################################################################
@@ -764,9 +764,9 @@ Impossible de trouver une version sans texte indésirable.
# modules/diff.pl
################################################################################
Page diff
Page diff
Diff
Diff
################################################################################
# modules/drafts.pl
################################################################################
@@ -806,11 +806,11 @@ modifications ordinaires
# modules/edit-paragraphs.pl
################################################################################
Could not identify the paragraph you were editing
Impossible d'identifier le paragraphe que vous avez édité
This is the section you edited:
Cest la section que vous avez éditée :
This is the current page:
Cest la page actuelle
################################################################################
# modules/find.pl
################################################################################
@@ -820,53 +820,53 @@ Pages correspondant aux noms :
# modules/fix-encoding.pl
################################################################################
Fix character encoding
Corriger lencodage des caractères
Fix HTML escapes
Corriger les caractères déchappement HTML
################################################################################
# modules/form_timeout.pl
################################################################################
Set $FormTimeoutSalt.
Définir $FormTimeoutSalt.
Form Timeout
################################################################################
# modules/gd_security_image.pl
################################################################################
GD or Image::Magick modules not available.
modules GD ou Image::Magick non disponibles.
GD::SecurityImage module not available.
module GD::SecurityImage non disponible.
Image storing failed. (%s)
Erreur denregistrement de limage. (%s)
Bad gd_security_image_id.
Invalide gd_security_image_id.
Please type the six characters from the anti-spam image
Entrez les six caractères de limage anti-spam
Submit
Soumettre
CAPTCHA
CAPTCHA
You did not answer correctly.
Vous navez pas répondu correctement.
$GdSecurityImageFont is not set.
$GdSecurityImageFont nest pas défini.
################################################################################
# modules/git-another.pl
################################################################################
No summary provided
Aucun résumé fourni
################################################################################
# modules/git.pl
################################################################################
no summary available
aucun résumé disponible
page was marked for deletion
page marquée pour suppression
Oddmuse
Oddmuse
Cleaning up git repository
Nettoyage du dépôt git
################################################################################
# modules/google-plus-one.pl
################################################################################
@@ -880,7 +880,7 @@ This page lists the twenty last diary entries and their +1 buttons.
# modules/gravatar.pl
################################################################################
Email:
Courriel :
################################################################################
# modules/header-and-footer-templates.pl
################################################################################
@@ -902,53 +902,53 @@ Index
# modules/joiner.pl
################################################################################
The username %s already exists.
Le nom dutilisateur %s existe déjà.
The email address %s has already been used.
Ladresse courriel %s a déjà été utilisée.
Wait %s minutes before try again.
Attendez %s minutes avant de réessayer.
Registration Confirmation
Confirmation de lenregistrement
Visit the link below to confirm registration.
Visitez le lien ci-dessous pour confirmer lenregistrement.
Recover Account
Restaurer le compte
You can login by following the link below. Then set new password.
Change Email Address
Changer ladresse courriel
To confirm changing email address, follow the link below.
To submit this form you must answer this question:
Question:
Question:
CAPTCHA:
CAPTCHA:
Registration
Enregistrement
The username must be valid page name.
Le nom dutilisateur doit être un nom de page valide.
Confirmation email will be sent to the email address.
Un courriel de confirmation sera envoyé à ladresse courriel.
Repeat Password:
Répétez le mot de passse :
Bad email address format.
Format dadresse courriel invalide.
Password needs to have at least %s characters.
Le mot de passe doit avoir au moins %s caractères.
Passwords differ.
Mots de passe différents.
Email Sent
Courriel envoyé
Confirmation email has been sent to %s. Visit the link on the mail to confirm registration.
Courriel de confirmation envoyé à %s. Visitez le lien du courriel de confirmation d'enregistrement.
Failed to Confirm Registration
Echec de confirmation d'enregistrement.
Invalid key.
Clé non valide.
The key expired.
Clé expirée.
Registration Confirmed
Now, you can login by using username and password.
@@ -956,65 +956,65 @@ Now, you can login by using username and password.
Forgot your password?
Mot de passe oublié ?
Login failed.
Connexion échouée.
You are banned.
You must confirm email address.
Vous devez confirmer l'adresse courriel.
Logged in
Connecté
%s has logged in.
%s est connecté
You should set new password immediately.
Vous devriez définir un nouveau mot de passe immédiatement.
Change Password
Changer le mot de passe
Logged out
Déconnecté
%s has logged out.
%s sest déconnecté
Account Settings
Paramètres de compte
Logout
Se déconnecter
Current Password:
Mot de passe actuel:
New Password:
Nouveau mot de passe:
Repeat New Password:
Répétez le mot de passe:
Password is wrong.
Mot de passe incorrect.
Password Changed
Mot de passe modifié
Your password has been changed.
Votre mot de passe a été modifié.
Forgot Password
Mot de passe oublié
Enter email address, and recovery login ticket will be sent.
Entrez une adresse courriel, un ticket de récupération de connexion sera envoyé.
Not found.
Non trouvé.
The mail address is not valid anymore.
Ladresse courriel nest plus valide.
An email has been sent to %s with further instructions.
Un courriel a été envoyé à %s avec les instructions complémentaires.
New Email Address:
Nouvelle adresse courriel:
Failed to load account.
Echec du chargement du compte.
An email has been sent to %s with a login ticket.
Un courriel a été envoyé à %s avec un ticket de connexion.
Confirmation Failed
Echec de confirmation
Failed to confirm.
Echec de confirmation
Email Address Changed
Adresse courriel modifiée
Email address for %1 has been changed to %2.
Adresse courriel pour %1 modifiée en %2.
Account Management
Gestion des comptes
Ban Account
Enter username of the account to ban:
@@ -1034,7 +1034,7 @@ Unban
%s has been unbanned.
Register
Enregistrement
################################################################################
# modules/lang.pl
################################################################################
@@ -1052,7 +1052,7 @@ Voir !
====1 person liked this====
I like this!
Jaime!
################################################################################
# modules/link-all.pl
################################################################################
@@ -1091,9 +1091,9 @@ Le modèle %s est soit vide soit n'existe pas.
# modules/localnames.pl
################################################################################
Name:
Nom :
URL:
URL:
Define Local Names
Define external redirect:
@@ -1106,7 +1106,7 @@ Noms locaux définis sur %1 : %2
# modules/logbannedcontent.pl
################################################################################
IP number matched %s
Numéro IP correspond à %s
################################################################################
# modules/login.pl
################################################################################
@@ -1209,8 +1209,8 @@ All mail subscriptions
Tous les abonnements e-mail
Subscriptions
Abonnements
Email:
Courriel :
Email:
Show
Voir
Subscriptions for %s:
@@ -1247,30 +1247,30 @@ Help convert %s to Markdown
List all non-Markdown pages
Converting %s
Conversion de %s
Candidates for Conversion to Markdown
################################################################################
# modules/module-bisect.pl
################################################################################
Bisect modules
Modules Bisect
Module Bisect
Module Bisect
All modules enabled now!
Tous les modules activés maintenant !
Go back
Retour
Test / Always enabled / Always disabled
Start
Démarrer
Bisecting proccess is already active.
Stop
Stop
It seems like module %s is causing your problem.
Le module %s sembler causer votre problème.
Please note that this module does not handle situations when your problem is caused by a combination of specific modules (which is rare anyway).
Good luck fixing your problem! ;)
@@ -1278,13 +1278,13 @@ Good luck fixing your problem! ;)
Module count (only testable modules):
Current module statuses:
Statuts du module courant :
Good
Bon
Bad
Mauvais
Enabling %s
Activer %s
################################################################################
# modules/module-updater.pl
################################################################################
@@ -1357,9 +1357,9 @@ L'extension "404 handler" nécessite une base de données de liens (links.pl).
# modules/offline.pl
################################################################################
Make available offline
Rendre disponible hors ligne
Offline
Hors ligne
You are currently offline and what you requested is not part of the offline application. You need to be online to do this.
################################################################################
@@ -1424,25 +1424,25 @@ Portrait
# modules/preview.pl
################################################################################
Pages with changed HTML
Pages avec HTML modifié
Preview changes in HTML output
Visualiser les changenements de la sortie HTML
################################################################################
# modules/private-pages.pl
################################################################################
This page is password protected. If you know the password, you can %s. Once you have done that, return and reload this page.
supply the password now
donner le mot de passe maintenant
################################################################################
# modules/private-wiki.pl
################################################################################
This error should not happen. If your password is set correctly and you are still seeing this message, then it is a bug, please report it. If you are just a stranger and trying to get unsolicited access, then keep in mind that all of the data is encrypted with AES-256 and the key is not stored on the server, good luck.
Attempt to read encrypted data without a password.
Tentative de lire des données cryptés sans mot de passe.
Cannot refresh index.
Impossible de mettre à jour l'index
################################################################################
# modules/publish.pl
################################################################################
@@ -1493,17 +1493,17 @@ Index de toutes les pages de petite taille
# modules/sort.pl
################################################################################
Sort alphabetically
Trier alphabétiquement
Sorted alphabetically
Trié alphabétiquement
Sorted by last update first
Trié par dernière modification en premier
Sort by last update
Trier par dernière modification
Sorted by creation date
Trié par date de création
Sort by creation date
Trier par date de création
################################################################################
# modules/static-copy.pl
################################################################################
@@ -1581,7 +1581,7 @@ Failed to run %1 to create thumbnail: %2
%s ran into an error
%s produced no output
%s na produit aucun résultat
Failed to parse %s.
################################################################################
@@ -1615,13 +1615,13 @@ Traduire %s
Thank you for writing a translation of %s.
Merci pour la traduction de %s.
Please indicate what language you will be using.
Merci dindiquer quelle langue vous allez utiliser.
Merci d'indiquer quelle langue vous allez utiliser.
Language is missing
La langue est manquante
Suggested languages:
Langues suggérées
Please indicate a page name for the translation of %s.
Indiquez sil vous plaît un nom de page pour la traduction de %s.
Indiquez s'il vous plaît un nom de page pour la traduction de %s.
More help may be available here: %s.
Plus d'aide disponible ici : %s.
Translated page:
@@ -1647,11 +1647,11 @@ Upgrading Database
Did the previous upgrade end with an error? A lock was left behind.
Unlock wiki
Déverrouiller le wiki
Upgrade complete.
Mise à jour terminée
Upgrade complete. Please remove $ModuleDir/upgade.pl, now.
Mise à jour terminée. SVP, supprimez $ModuleDir/upgade.pl maintenant.
################################################################################
# modules/usemod.pl
################################################################################

View File

@@ -1201,8 +1201,6 @@ Your mail subscriptions
All mail subscriptions
All mail subscribers
Subscriptions
Email:
@@ -1229,8 +1227,6 @@ The remaining pages do not exist.
Unsubscribed %s from the following pages:
Unsubscribed %s from all pages.
Migrating Subscriptions
No non-migrated email addresses found, migration not necessary.
@@ -1718,8 +1714,6 @@ Tags:
################################################################################
# modules/webmention.pl
################################################################################
Webmention module requires $CommentsPrefix to be set
Webmention requires a POST request
Webmention requires x-www-form-urlencoded requests
@@ -1746,25 +1740,5 @@ Webmention for %s already exists
Webmention OK!
Add webmentions
Webmentioning others from %s
Webmention!
No links found.
Webmentioning somebody from %s
Contacting %s
Target reports an error: %s
No Webmention URL found
Success: %s
Failure: %s
#
END_OF_TRANSLATION

View File

@@ -5,7 +5,6 @@
# Zrajm C Akfohg <zrajm@klingonska.org>
# Copyright (c) 2004-06 Johan Adler <alltid@nyfiken.org>
# Copyright (c) 2004 Zrajm C Akfohg <zrajm@klingonska.org>
# Copyright (c) 2021 Tobias Fendin
#
# Permission is granted to copy, distribute and/or modify this
# document under the terms of the GNU Free Documentation License,
@@ -301,8 +300,6 @@ Delete
Filter:
Summary:
Sammanfattning:
Last edit
revision %s
@@ -317,6 +314,8 @@ later minor edits
No diff available.
Information om ändring är inte tillgänglig.
Summary:
Sammanfattning:
Old revision:
Gammal version:
Changed:
@@ -700,6 +699,11 @@ Clustermap
Klusterkarta
Pages without a Cluster
Sidor utan kluster
################################################################################
# modules/comment-div-wrapper.pl
################################################################################
Comments:
################################################################################
# modules/commentcount.pl
################################################################################
@@ -707,11 +711,6 @@ Comments on
Kommentarer till
Comment on
Kommentar till
################################################################################
# modules/comment-div-wrapper.pl
################################################################################
Comments:
################################################################################
# modules/compilation.pl
################################################################################
@@ -1206,8 +1205,6 @@ Your mail subscriptions
All mail subscriptions
All mail subscribers
Subscriptions
Email:
@@ -1234,8 +1231,6 @@ The remaining pages do not exist.
Unsubscribed %s from the following pages:
Unsubscribed %s from all pages.
Migrating Subscriptions
No non-migrated email addresses found, migration not necessary.
@@ -1309,11 +1304,6 @@ You linked more than %s times to the same domain. It would seem that only a spam
Namespaces
################################################################################
# modules/nearlink-create.pl
################################################################################
(create locally)
################################################################################
# modules/near-links.pl
################################################################################
@@ -1333,6 +1323,11 @@ EditNearLinks
Redigera närlänkar
The same page on other sites:
Samma sida andra siter:
################################################################################
# modules/nearlink-create.pl
################################################################################
(create locally)
################################################################################
# modules/no-question-mark.pl
################################################################################
@@ -1418,11 +1413,6 @@ Click to search for references to this permanent anchor
Klicka för att söka efter referenser till det här permanenta ankaret
Include permanent anchors
Med permanenta ankare
################################################################################
# modules/pingback-server.pl
################################################################################
Only XML-RPC POST requests recognised
################################################################################
# modules/portrait-support.pl
################################################################################
@@ -1487,17 +1477,6 @@ Sidor som länkat hit
################################################################################
All Referrers
Alla som länkat hit
################################################################################
# modules/rename-pages.pl
################################################################################
Target page already exists.
Source page does not exist.
Copied from %s
Moved to %s
################################################################################
# modules/search-list.pl
################################################################################
@@ -1507,22 +1486,22 @@ Page list for %s
# modules/small.pl
################################################################################
Index of all small pages
Index av alla små sidor
################################################################################
# modules/sort.pl
################################################################################
Sort alphabetically
Sortera alfabetiskt
Sorted alphabetically
Sorterad alfabetiskt
Sorted by last update first
Sorterad med senast uppdaterad först
Sort by last update
Sortera uppdateringstid
Sorted by creation date
Sorterad skapande datum
Sort by creation date
Sortera skapande datum
################################################################################
# modules/static-copy.pl
################################################################################
@@ -1539,33 +1518,35 @@ Editing not allowed for %s.
# modules/svg-edit.pl
################################################################################
Edit image in the browser
Redigera bilden i webbläsaren
Summary of your changes:
Sammanställning av dina ändringar:
################################################################################
# modules/sync.pl
################################################################################
Copy to %1 succeeded: %2.
Kopiering till %1 lyckades: %2.
Copy to %1 failed: %2.
Kopiering till %1 misslyckades: %2.
################################################################################
# modules/tags.pl
################################################################################
Tag
Tagg
Feed for this tag
Flöde för denna tagg
Tag Cloud
Taggmoln
Rebuilding index not done.
Ombyggnad av index inte klart.
(Rebuilding the index can only be done once every 12 hours.)
(Ombyggnad av indexet kan endast göras var 12:e timme.)
Rebuild tag index
Bygg om tagg index
list tags
tag cloud
taggmoln
################################################################################
# modules/templates.pl
################################################################################
@@ -1575,41 +1556,41 @@ Eller använd en av följande mallar:
# modules/throttle.pl
################################################################################
Too many instances. Only %s allowed.
För många instanser. Endast %s tillåtna.
Please try again later. Perhaps somebody is running maintenance or doing a long search. Unfortunately the site has limited resources, and so we must ask you for a bit of patience.
Vänligen försök senare. Kanske pågår ett underhåll eller har någon gjort en lång sökning. Dessvärre har denna sida begränsade resurser, vi ber dig ha tålamod.
################################################################################
# modules/thumbs.pl
################################################################################
thumb
Error creating thumbnail from nonexisting page %s.
Misslyckades med att skapa miniatyr av en icke existerande sida %s.
Can not create thumbnail for file type %s.
Kan inte skapa miniatyr för filtypen %s.
Can not create thumbnail for a text document
Kan inte skapa en miniatyr av ett textdokument
Can not create path for thumbnail - %s
Kan inte skapa sökväg för miniatyr - %s
Could not open %s for writing whilst trying to save image before creating thumbnail. Check write permissions.
Kan inte öppna %s för skrivning före skapande av miniatyrbilden. Kontrollera skrivrättigheter.
Failed to run %1 to create thumbnail: %2
Kunde inte köra %1 för att skapa miniatyren: %2
%s ran into an error
%s misslyckades
%s produced no output
%s producerade ingen utdata
Failed to parse %s.
Misslyckades med att tolka %s.
################################################################################
# modules/timezone.pl
################################################################################
Timezone
Tidszon
Pick your timezone:
Välj din tidszon:
Set
Sätt
################################################################################
# modules/toc-headers.pl
################################################################################
@@ -1619,7 +1600,7 @@ Innehåll
# modules/today.pl
################################################################################
Create a new page for today
Skapa en ny sida för idag
################################################################################
# modules/translation-links.pl
################################################################################
@@ -1660,15 +1641,15 @@ Sidan finns inte.
# modules/upgrade.pl
################################################################################
Upgrading Database
Uppgradering av databas
Did the previous upgrade end with an error? A lock was left behind.
Misslyckades den senaste uppgraderingen med ett fel? Ett lås finns kvar.
Unlock wiki
Lås upp wiki
Upgrade complete.
Uppgradering klar.
Upgrade complete. Please remove $ModuleDir/upgade.pl, now.
Uppgradering klar. Vänlingen ta bort $ModuleDir/upgade.pl nu.
################################################################################
# modules/usemod.pl
################################################################################
@@ -1695,7 +1676,7 @@ Wanted Pages
# modules/webapp.pl
################################################################################
Web application for offline browsing
Webbapplikation för off-line visning
################################################################################
# modules/webdav.pl
################################################################################
@@ -1710,68 +1691,15 @@ Blogg
# modules/weblog-3.pl
################################################################################
Matching pages:
Matchande sidor:
New
Nytt
Edit %s.
Redigera %s.
################################################################################
# modules/weblog-4.pl
################################################################################
Tags:
Taggar:
################################################################################
# modules/webmention.pl
################################################################################
Webmention module requires $CommentsPrefix to be set
Webmention modulen kräver att $CommentsPrefix är satt
Webmention requires a POST request
Webmention kräver en POST förfrågan
Webmention requires x-www-form-urlencoded requests
Webmention kräver x-www-form-urlencoded förfrågan
Webmention must mention a specific page
Webmention måste ange en specifik sida
Webmention must mention a valid page
Webmention måste ange en giltig sida
Your IP number is blocked: %s
Ditt IP-nummer är blockerat: %s
Webmention must mention an existing page
Webmention måste ange en existerande sida
Webmention must mention source
Webmention måste ange en källa
Webmention must mention target
Webmention måste ange ett mål
The URL is blocked: %s
URL:en är blockerad: %s
Webmention source cannot be verified: %1 returns %2 %3
Webmention källan kan inte verifieras: %1 returnerar %2 %3
Webmention source does not link to %s
Webmention källan länkar inte till %s
Webmention for %s already exists
Webmention för %s finns redan
Webmention OK!
Add webmentions
Lägg till webmention
# Could not find a good translation of "Webmentioning"
Webmentioning others from %s
Webmentioning andra från %s
Webmention!
No links found.
Inga länkar hittade
Webmentioning somebody from %s
Webmentioning någon från %s
Contacting %s
Kontakta %s
Target reports an error: %s
Målet rapporterar ett fel: %s
No Webmention URL found
Ingen Webmention URL hittad
Success: %s
Lyckat: %s
Failure: %s
Misslyckat: %s
#
END_OF_TRANSLATION

View File

@@ -23,7 +23,7 @@
use strict;
use v5.10;
our (@MyInitVariables, $HtmlHeaders, $EditNote);
our (@MyInitVariables, $HtmlHeaders);
AddModuleDescription('wordcount.pl', 'Word Count Extension');
@@ -57,5 +57,3 @@ sub WordcountAddScript {
}
</script>";
}
$EditNote = "Words: <span id='textWordCount'></span>" . $EditNote;

View File

@@ -173,7 +173,7 @@ sub send_mail {
Path => $fh,
Type=> "text/html");
if ($host) {
print "$root\nSending $title to $subscriber using ${user}\@${host}\n" if $verbose;
print "Sending $title to $subscriber using ${user}\@${host}\n" if $verbose;
my $smtp = Net::SMTP->new($host, Debug => $debug);
$smtp->starttls();
# the following requires Authen::SASL!

View File

@@ -1,91 +0,0 @@
#! /usr/bin/perl -w
# Copyright (C) 2005, 2007, 2021 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/>.
use Modern::Perl;
sub ParseData {
my $data = shift;
my %result;
while ($data =~ /(\S+?): (.*?)(?=\n[^ \t]|\Z)/sg) {
my ($key, $value) = ($1, $2);
$value =~ s/\n\t/\n/g;
$result{$key} = $value;
}
return %result;
}
sub main {
my ($PageDir) = @_;
my $pages = 0;
my $texts = 0;
my $redirects = 0;
my $files = 0;
my $big = 0;
# include dotfiles!
local $/ = undef; # Read complete files
say "Reading files...";
my @files = glob("$PageDir/*.pg $PageDir/.*.pg");
my $n = @files;
local $| = 1; # flush!
foreach my $file (@files) {
if (not --$n % 10) {
printf("\r%06d files to go", $n);
}
next unless $file =~ m|.*/(.+)\.pg$|;
my $page = $1;
open(F, $file) or die "Cannot read $page file: $!";
my $data = <F>;
close(F);
my %result = ParseData($data);
$pages++;
if ($result{text} =~ /^#FILE /) {
$files++;
} elsif ($result{text} =~ /^#REDIRECT /) {
$redirects++;
} else {
$texts++;
$big++ if length($result{text}) > 15000;
}
}
printf("\r%06d files to go\n", 0);
printf("Pages: %7d\n", $pages);
printf("Files: %7d\n", $files);
printf("Redirects: %6d\n", $redirects);
printf("Texts: %7d\n", $texts);
printf("Big: %7d\n", $big);
}
use Getopt::Long;
my $regexp = undef;
my $page = 'page';
my $help;
GetOptions ("page=s" => \$page,
"help" => \$help);
if ($help) {
print qq{
Usage: $0 [--page DIR]
Prints some stats about the pages in DIR.
--page designates the page directory. By default this is 'page' in the
current directory. If you run this script in your data directory,
the default should be fine.
}
} else {
main ($page);
}

View File

@@ -85,9 +85,7 @@ versions of Oddmuse.</p>
<ul>
% for my $tarball (@$tarballs) {
<li>
% if ($tarball ne 'latest') {
<a href="https://oddmuse.org/releases/<%= $tarball %>.tar.gz"><%= $tarball %>.tar.gz</a>
% }
(files for <%= link_to release => {tarball => $tarball} => begin %>\
<%= $tarball =%><%= end %>)
</li>

View File

@@ -1,120 +0,0 @@
#! /usr/bin/perl
# Copyright (C) 20102021 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/>.
=head1 NAME
unsubscribe.pl - mass unsubscribe from Oddmuse
=head2 SYNOPSIS
B<perl unsubscribe.pl> F<MAILDB> [B<--regexp=>I<REGEXP>]
B<perl unsubscribe.pl> F<MAILDB> [B<--dump>]
=head2 DESCRIPTION
If you use the Mail Extension to Oddmuse, you end up with subscriptions to very
old pages. This script helps you unsubsribe people from old pages.
C<--regexp> indicates a regular expression matching pages names
The mandatory F<MAILDB> argument is the file containing all the mail
subscriptions.
=head2 EXAMPLES
Make a copy, unsubscribe people, check a dump of the remaining subscriptions,
and move the file back to the wiki data directory.
cp ~/alexschroeder/mail.db copy.db
perl ~/src/oddmuse/scripts/unsubscribe.pl copy.db --regexp='20[01][0-9]'
perl ~/src/oddmuse/scripts/unsubscribe.pl copy.db --dump
mv copy.db ~/alexschroeder/mail.db
=cut;
use Modern::Perl;
use Getopt::Long;
use Encode qw(encode_utf8 decode_utf8);
use DB_File;
binmode(STDOUT, ":utf8");
my $re = "";
my $confirm;
my $dump;
GetOptions ("regexp=s" => \$re,
"dump" => \$dump,
"confirm" => \$confirm, );
my $file = shift;
die "Not a file: $file" unless -f $file;
die "Unknown arguments: @ARGV" if @ARGV;
sub UrlEncode {
my $str = shift;
return '' unless $str;
my @letters = split(//, encode_utf8($str));
my %safe = map {$_ => 1} ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '-', '_', '.', '!', '~', '*', "'", '(', ')', '#');
foreach my $letter (@letters) {
$letter = sprintf("%%%02x", ord($letter)) unless $safe{$letter};
}
return join('', @letters);
}
sub UrlDecode {
my $str = shift;
return '' unless $str;
$str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eig;
return decode_utf8($str);
}
tie my %h, "DB_File", $file;
my $FS = "\x1e";
if ($dump) {
for my $key (keys %h) {
my @value = split /$FS/, UrlDecode($h{$key});
say UrlDecode($key), ": @value";
}
exit;
}
for my $raw (keys %h) {
if ($raw =~ /@/) {
# email address
my $mail = UrlDecode($raw);
my $value = $h{$raw};
my @subscriptions = grep !/$re/, map { UrlDecode($_) } split /$FS/, $value;
if (@subscriptions) {
$h{$raw} = join $FS, map { UrlEncode($_) } @subscriptions if $confirm;
say "> $mail: remains subscribed to @subscriptions";
} else {
delete $h{$raw} if $confirm;
say "> $mail: unsubscribe from all pages";
}
} else {
my $id = UrlDecode($raw);
next unless $id =~ /$re/;
delete $h{$raw} if $confirm;
say "Delete $id";
}
}
untie %h;
say "Use --confirm to actually do it" unless $confirm;

File diff suppressed because it is too large Load Diff

View File

@@ -33,7 +33,7 @@ EOT
my $min = version->parse(shift || "2.3.0");
my @tags = grep { /(\d+\.\d+\.\d+)/ and version->parse($1) >= $min }
my @tags = grep { /(\d+\.\d+\.\d+)/ and version->parse($1) >= $min }
split(/\n/, qx{git tag --list});
unless (@tags) {
@@ -47,7 +47,7 @@ for my $tag (@tags) {
next;
}
print "Preparing $tag\n";
system("git", "checkout", $tag) == 0
or die "Failed to git checkout $tag\n";
system("make", "prepare") == 0
@@ -62,5 +62,5 @@ for my $tag (@tags) {
or die "Failed to remove the directory oddmuse-$tag\n";
}
system("git", "checkout", "main") == 0
or die "Failed to git checkout main\n";
system("git", "checkout", "master") == 0
or die "Failed to git checkout master\n";

View File

@@ -15,42 +15,13 @@
require './t/test.pl';
package OddMuse;
use Test::More;
use Net::IP;
add_module('ban-contributors.pl');
# 0-255
is(BanContributors::get_regexp_ip('185.244.214.0', '185.244.214.255'),
'^185\.244\.214\.',
'185.244.214.0 - 185.244.214.255');
# 48.0-63.255
is(BanContributors::get_regexp_ip('42.118.48.0', '42.118.63.255'),
'^42\.118\.(4[8-9]|5[0-9]|6[0-3])\.',
'42.118.48.0 - 42.118.63.255');
# 192.0-223.255
is(BanContributors::get_regexp_ip('118.71.192.0', '118.71.223.255'),
'^118\.71\.(19[2-9]|2[0-1][0-9]|22[0-3])\.',
'118.71.192.0 - 118.71.223.255');
# 56.180-57.70
is(BanContributors::get_regexp_ip('77.56.180.0', '77.57.70.255'),
'^77\.(56\.(1[8-9][0-9]|2[0-4][0-9]|25[0-5])|57\.([0-9]|[1-6][0-9]|70)\.',
'^77\.(56\.(1[8-9][0-9]|2[0-4][0-9]|25[0-5])|5[7-9]|6[0-9]|70)\.',
'77.56.180.0 - 77.57.70.255');
# 45.87.2.128 - 45.87.2.255
is(BanContributors::get_regexp_ip('45.87.2.128', '45.87.2.255'),
'^45\.87\.2\.(12[8-9]|1[3-9][0-9]|2[0-4][0-9]|25[0-5])',
'45.87.2.128 - 45.87.2.255');
# 191.101.0.0/16
# verify that Net::IP works as intended
my $ip = Net::IP->new('191.101.0.0/16');
ok($ip, 'Net::IP parsed CIDR');
is($ip->ip, '191.101.0.0', 'First IP in range');
is($ip->last_ip, '191.101.255.255', 'Last IP in range');
$localhost = '127.0.0.1';
$ENV{'REMOTE_ADDR'} = $localhost;
@@ -86,9 +57,10 @@ test_page($page, 'Rolling back changes', 'These URLs were rolled back',
'doxycycline');
test_page_negative($page, 'amoxil');
# 127.0.0.1 has no inetnum
test_page(get_page("action=ban id=Test"),
'Ban Contributors to Test',
quotemeta('127.0.0.1 () [127.0.0.0 - 127.255.255.255]'));
quotemeta('127.0.0.1 () [ - ]'));
SKIP: {
skip "Net::Whois::Parser doesn't always return the same result", 4;
@@ -101,7 +73,7 @@ SKIP: {
test_page(get_page('action=ban id=Test regexp="^46\.101\.([0-9]|[1-9][0-9]|1[0-1][0-9]|12[0-7])" range="[46.101.0.0 - 46.101.127.255]" recent_edit=on pwd=foo'),
'Location: http://localhost/wiki.pl/BannedHosts');
test_page(get_page('BannedHosts'),
quotemeta('^46\.101\.([0-9]|[1-9][0-9]|1[0-1][0-9]|12[0-7]) # '
. CalcDay($Now)

View File

@@ -31,15 +31,15 @@ add_module('calendar.pl');
test_page(update_page("with_cal", "zulu\n\ncalendar:2006\n\nwarrior\n"),
'<p>zulu</p><p class="nav">',
'</pre></div><p>warrior</p></div><div class="wrapper close"></div></div><footer>');
'</pre></div><p>warrior</p></div><div class="wrapper close"></div></div><div class="footer">');
test_page(update_page("with_cal", "zulu\n\nmonth:2006-09\n\nwarrior\n"),
'<p>zulu</p><div class="cal"><div class="month"><pre>',
'</pre></div></div><p>warrior</p></div><div class="wrapper close"></div></div><footer>');
'</pre></div></div><p>warrior</p></div><div class="wrapper close"></div></div><div class="footer">');
test_page(update_page("with_cal", "zulu\n\nmonth:+0\n\nwarrior\n"),
'<p>zulu</p><div class="cal"><div class="month"><pre>',
'</pre></div></div><p>warrior</p></div><div class="wrapper close"></div></div><footer>');
'</pre></div></div><p>warrior</p></div><div class="wrapper close"></div></div><div class="footer">');
xpath_test(get_page('action=calendar'),
# yearly navigation

File diff suppressed because it is too large Load Diff

49
t/common-markdown.t Normal file
View File

@@ -0,0 +1,49 @@
#!/usr/bin/env perl
# Copyright (C) 2018 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/>.
require './t/test.pl';
package OddMuse;
use Test::More;
use JSON;
use utf8;
add_module('common-markdown.pl');
sub load_tests {
my $spec = "t/common-markdown-spec-0.28.json";
open(my $fh, "<", $spec)
or die "Cannot open $spec: $!";
local $/ = undef;
return decode_json <$fh>;
}
sub normalize {
my $html = shift;
$html =~ s/\n$//s;
return $html;
}
my $tests = load_tests();
for my $test (@$tests) {
my $name = $test->{example} . ". (" . $test->{section} . ")";
my $input = $test->{markdown};
my $output = apply_rules($input, 'p');
my $correct = normalize($test->{html});
is($output, $correct, $name);
}
done_testing();

View File

@@ -21,4 +21,4 @@ AppendStringToFile($ConfigFile, "\$ConfigPage = 'Config';\n");
xpath_test(update_page('Config', '@UserGotoBarPages = ("Foo", "Bar");',
'config', 0, 1),
'//header/nav/span[@class="gotobar bar"]/a[@class="local"][text()="Foo"]/following-sibling::a[@class="local"][text()="Bar"]');
'//div[@class="header"]/div[@class="menu"]/span[@class="gotobar bar"]/a[@class="local"][text()="Foo"]/following-sibling::a[@class="local"][text()="Bar"]');

View File

@@ -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://duckduckgo.com/\?q=alex\+site%3Aemacswiki\.org');
'Location: https://www.duckduckgo.com/\?q=alex\+site%3Aemacswiki\.org');

View File

@@ -23,18 +23,18 @@ test_page(update_page('2011-07-06', 'Hallo'),
'Comments_on_2011-07-06');
xpath_test(update_page('Hi', '<journal>'),
'//h1/a[text()="2011-07-06"]',
'//div[@class="journal h-feed"]/article[@class="h-entry"]/p[@class="comment"]/a[text()="Comments on this page"]');
'//div[@class="journal h-feed"]/div[@class="page h-entry"]/p[@class="comment"]/a[text()="Comments on this page"]');
add_module('dynamic-comments.pl');
xpath_test(get_page('Hi'),
'//div[@class="journal h-feed"]/article[@class="h-entry"]/p[@class="comment"]/a[@href="http://localhost/wiki.pl/Comments_on_2011-07-06"][text()="Add Comment"]');
'//div[@class="journal h-feed"]/div[@class="page h-entry"]/p[@class="comment"]/a[@href="http://localhost/wiki.pl/Comments_on_2011-07-06"][text()="Add Comment"]');
test_page(update_page('Comments_on_2011-07-06', 'Yo'),
'Yo');
xpath_test(get_page('Hi'),
'//div[@class="journal h-feed"]/article[@class="h-entry"]/p[@class="comment"]/a[@href="javascript:togglecomments(\'id0\')"][text()="Comments on 2011-07-06"]');
'//div[@class="journal h-feed"]/div[@class="page h-entry"]/p[@class="comment"]/a[@href="javascript:togglecomments(\'id0\')"][text()="Comments on 2011-07-06"]');
# encoding basics
$page = update_page('2011-07-06_(…)_Dü', 'Hallo Dü');
@@ -44,6 +44,6 @@ xpath_test($page, '//p[contains(text(), "Dü")]');
update_page('Comments_on_2011-07-06_(…)_Dü', 'Yo');
xpath_test(update_page('Hi', '<journal>'),
'//h1/a[text()="2011-07-06 (…) Dü"]',
'//div[@class="journal h-feed"]/article[@class="h-entry"]/p[@class="comment"]/a[text()="Comments on 2011-07-06 (…) Dü"]',
'//div[@class="journal h-feed"]/article[@class="h-entry"]/p[@class="comment"]/a[@href="javascript:togglecomments(\'id0\')"]');
'//h1/a[text()="2011-07-06 (…) Dü"]',
'//div[@class="journal h-feed"]/div[@class="page h-entry"]/p[@class="comment"]/a[text()="Comments on 2011-07-06 (…) Dü"]',
'//div[@class="journal h-feed"]/div[@class="page h-entry"]/p[@class="comment"]/a[@href="javascript:togglecomments(\'id0\')"]');

View File

@@ -21,5 +21,5 @@ xpath_test(get_page('action=edit id=NewPage'),
'//textarea[@name="text"][@id="text"][not(boolean(text()))]',
'//div[@class="wrapper"]/div[@class="content edit"]',
'//div[@class="content edit"]/following-sibling::div[@class="wrapper close"]',
'//div[@class="wrapper"]/following-sibling::footer',
'//div[@class="wrapper"]/following-sibling::div[@class="footer"]',
);

View File

@@ -1,340 +0,0 @@
# Copyright (C) 20172020 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();

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2008-2021 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2008-2019 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
@@ -15,7 +15,7 @@
require './t/test.pl';
package OddMuse;
use Test::More tests => 45;
use Test::More tests => 43;
add_module('journal-rss.pl');
@@ -113,7 +113,3 @@ xpath_test(get_page('action=journal search=tag:oddmuse'),
'//atom:link[@rel="self"][@href="http://localhost/wiki.pl?action=journal;search=tag%3aoddmuse"]',
'//atom:link[@rel="last"][@href="http://localhost/wiki.pl?action=journal;search=tag%3aoddmuse"]',
'//atom:link[@rel="previous"][@href="http://localhost/wiki.pl?action=journal;offset=10;search=tag%3aoddmuse"]');
# check raw
$page = get_page('action=journal raw=1 rsslimit=1');
test_page($page, 'generator: Oddmuse', 'title: 2008-09-22');

View File

@@ -16,7 +16,7 @@
require './t/test.pl';
package OddMuse;
use Test::More tests => 68;
use Test::More tests => 67;
add_module('markdown-rule.pl');
add_module('bbcode.pl');
@@ -99,8 +99,6 @@ 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```
@@ -137,13 +135,13 @@ EOT
xpath_run_tests(split(/\n/,<<'EOT'));
[example](http://example.com/)
//a[@class="url"][@href="http://example.com/"][text()="example"]
//a[@class="url http"][@href="http://example.com/"][text()="example"]
[an example](http://example.com/)
//a[@class="url"][@href="http://example.com/"][text()="an example"]
//a[@class="url http"][@href="http://example.com/"][text()="an example"]
[an example](http://example.com/ "Title")
//a[@class="url"][@href="http://example.com/"][@title="Title"][text()="an example"]
//a[@class="url http"][@href="http://example.com/"][@title="Title"][text()="an example"]
[an\nexample](http://example.com/)
//a[@class="url"][@href="http://example.com/"][text()="an\nexample"]
//a[@class="url http"][@href="http://example.com/"][text()="an\nexample"]
\n[an\n\nexample](http://example.com/)
//p[text()="[an"]/following-sibling::p//text()[contains(string(),"example](")]
EOT

View File

@@ -14,7 +14,7 @@
require './t/test.pl';
package OddMuse;
use Test::More tests => 89;
use Test::More tests => 82;
use utf8; # tests contain UTF-8 characters and it matters
add_module('namespaces.pl');
@@ -202,14 +202,3 @@ test_page(update_page('Bond', 'My name is Bond', '007 ns', undef, undef,
test_page(get_page('action=browse id=Bond ns=007'),
'<title>Wiki 007: Bond</title>',
'<p>My name is Bond</p>');
# BannedHosts are shared! Editing the BannedHosts in a namespace results in the root BannedHosts getting written.
test_page(update_page('BannedHosts', '^127\.0\.0\.1', 'ban myself', undef, 1, 'ns=007', 'username=James'),
'<title>Wiki 007: Banned Hosts</title>', 'This page does not exist');
test_page(get_page('BannedHosts'), quotemeta('^127\.0\.0\.1'));
test_page(update_page('Mr._Q', 'Hello'), 'This page does not exist');
test_page(update_page('Mr._Q', 'Hello', undef, undef, undef, 'ns=007'), 'This page does not exist');
test_page(update_page('Mr._Q', 'Hello', undef, undef, undef, 'ns=008'), 'This page does not exist');
update_page('BannedHosts', '', 'unban myself', undef, 1);
test_page(update_page('Mr._Q', 'Hello'), 'Hello');

View File

@@ -22,9 +22,9 @@ add_module('page-trail.pl');
my $page = get_page('FirstPage');
xpath_test($page,
'//header/nav/span[@class="gotobar bar"]/following-sibling::span[@class="trail"]',
'//span[@class="trail"][contains(text(),"Trail: ")]/br',
'//span[@class="trail"]/a[@class="local"][@href="http://localhost/wiki.pl/FirstPage"][text()="FirstPage"]');
'//div[@class="header"]/div[@class="menu"]/span[@class="gotobar bar"]/following-sibling::span[@class="trail"]',
'//span[@class="trail"][contains(text(),"Trail: ")]/br',
'//span[@class="trail"]/a[@class="local"][@href="http://localhost/wiki.pl/FirstPage"][text()="FirstPage"]');
# verify cookie
test_page($page, 'Set-Cookie: Wiki=trail%251eFirstPage');

2
t/rc.t
View File

@@ -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: \d\d\d\d',
'description: test', 'generator: Anonymous',
'link: http://localhost/wiki.pl/test',
'last-modified: 1970-01-01T00:00Z', 'revision: 1');

View File

@@ -1,58 +0,0 @@
# Copyright (C) 20062023 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/>.
require './t/test.pl';
package OddMuse;
use Test::More tests => 4;
use utf8;
# Reproduce a particular bug from alexschroeder.ch with the rc.log provided.
WriteStringToFile($RcFile, <<'EOT');
16853910992023-05-29_Net_newsHow to IRCAnonymousAlex2en
16854004152023-05-29_Net_newsHow to IRCAnonymousAlex3en
1685430599[[rollback]]1685400415Anonymous
16855185032023-05-29_Net_newsAnonymousAlex4en
EOT
local $SIG{ALRM} = sub { fail "timeout!"; kill 'KILL', $$; };
alarm 3;
# this is recent changes from between the rollback and the page before it, so there are no pages to roll back
my $page = get_page("action=rss full=1 short=0 from=1685413682");
alarm 0;
test_page($page, '2023-05-29 Net news');
test_page_negative($page, 'rollback');
# Reproduce a follow-up bug. First, rolling back just Test works as intended.
WriteStringToFile($RcFile, <<'EOT');
1691499987Testham127.0.0.1Berta1
1691499988Mustuff127.0.0.1Chris1
1691499989Testspam127.0.0.1Spammer2
1691499990Test0Rollback to 2023-08-08 13:06 UTC127.0.0.1Alex3
1691499990[[rollback]]1691499987Test
EOT
my $feed = get_page('action=rc raw=1');
test_page($feed, 'title: Test');
# Rolling back all of the wiki doesn't work.
WriteStringToFile($RcFile, <<'EOT');
1691499987Testham127.0.0.1Berta1
1691499988Mustuff127.0.0.1Chris1
1691499989Testspam127.0.0.1Spammer2
1691499990Test0Rollback to 2023-08-08 13:06 UTC127.0.0.1Alex3
1691499990[[rollback]]1691499987
EOT
$feed = get_page('action=rc raw=1');
test_page($feed, 'title: Test');

View File

@@ -70,7 +70,7 @@ test_page(get_page('action=rss full=1'),
'<title>12h50 Forget It</title>', # wrong
'<title>2008-08-08</title>',
'<title>Comments on New Hope</title>',
'<description>&lt;div class="e-content" lang="en"&gt;&lt;p&gt;foo foo&lt;/p&gt;&lt;/div&gt;</description>');
'<description>&lt;div class="page" lang="en"&gt;&lt;p&gt;foo foo&lt;/p&gt;&lt;/div&gt;</description>');
# no stripping of dates
test_page(get_page('action=rss short=0'),

View File

@@ -42,7 +42,7 @@ require 'wiki.pl';
# our $ENV{PATH} is set to /bin:/usr/bin in order to find diff and
# grep.
if ($ENV{PERLBREW_PATH}) {
$ENV{PATH} = join(':', split(/ /, $ENV{PERLBREW_PATH}), $ENV{PATH});
$ENV{PATH} = $ENV{PERLBREW_PATH} . ':' . $ENV{PATH};
} elsif (-f '/usr/local/bin/perl') {
$ENV{PATH} = '/usr/local/bin:' . $ENV{PATH};
}
@@ -146,13 +146,11 @@ sub run_tests_negative {
}
sub apply_rules {
my $input = shift;
local *STDOUT;
$output = '';
open(STDOUT, '>', \$output) or die "Can't open memory file: $!";
$FootnoteNumber = 0;
ApplyRules(QuoteHtml($input), 1);
return $output;
return ToString(sub {
my $input = shift;
$FootnoteNumber = 0;
ApplyRules(QuoteHtml($input), 1, undef, undef, @_);
}, @_);
}
# alternating input and output strings for applying macros instead of rules
@@ -197,24 +195,16 @@ sub test_page_negative {
sub xpath_do {
my ($check, $message, $page, @tests) = @_;
$page =~ s/^(.+\r\n)*\r\n//; # strip headers
my $xml = $page =~ s/^.*?<\?xml.*?>\s*//s; # strip xml processing
$page =~ s/^.*?(<html)/$1/s; # strip headers
$page =~ s/^.*?<\?xml.*?>\s*//s; # strip xml processing
my $page_shown = 0;
my $parser = XML::LibXML->new(recover => 1, suppress_errors => 1); # allow HTML5 tags
my $parser = XML::LibXML->new();
my $doc;
my @result;
SKIP:
{
if ($xml) {
eval { $doc = $parser->parse_string($page) };
} else {
eval { $doc = $parser->parse_html_string($page) };
}
if ($@) {
skip("Cannot parse ".name($page).": $@", $#tests + 1);
return;
}
# warn "Doc: '$doc'\n";
SKIP: {
eval { $doc = $parser->parse_html_string($page) };
eval { $doc = $parser->parse_string($page) } if $@;
skip("Cannot parse ".name($page).": $@", $#tests + 1) if $@;
foreach my $test (@tests) {
my $nodelist;
# libxml2 is not aware of UTF8 flag

View File

@@ -33,7 +33,7 @@ $page = update_page('HomePage', 'This is the homepage. [[de:HauptSeite]] [[fr:Pa
test_page($page, 'This is the homepage.', 'fr:PagePrincipale',
'action=translate;id=HomePage;missing=en', 'Add Translation');
test_page_negative($page, 'de:HauptSeite');
xpath_test($page, '//footer/span[@class="translation bar"]/a[@class="translation de"][@href="http://localhost/wiki.pl/HauptSeite"][text()="Deutsch"]');
xpath_test($page, '//div[@class="footer"]/span[@class="translation bar"]/a[@class="translation de"][@href="http://localhost/wiki.pl/HauptSeite"][text()="Deutsch"]');
AppendStringToFile($ConfigFile, q{
%Languages = ('de' => '\b(der|die|das|und|oder)\b',
@@ -45,7 +45,7 @@ $Translate{en} = 'English';
});
xpath_test(update_page('HomePage', 'Simple test. [[de:HauptSeite]]'),
'//footer/span[@class="translation bar"]/a[@class="translation new"][text()="Add Translation"][@href="http://localhost/wiki.pl?action=translate;id=HomePage;missing=en_fr"]');
'//div[@class="footer"]/span[@class="translation bar"]/a[@class="translation new"][text()="Add Translation"][@href="http://localhost/wiki.pl?action=translate;id=HomePage;missing=en_fr"]');
$page = get_page('action=translate id=HomePage missing=en_fr');
test_page($page, 'Français', 'English');
@@ -53,7 +53,7 @@ test_page_negative($page, 'Deutsch');
# the page is now autoidentified as English, therefore French is the only one that is missing!
xpath_test(update_page('HomePage', 'The the the the test. [[de:HauptSeite]]'),
'//footer/span[@class="translation bar"]/a[@class="translation new"][text()="Add Translation"][@href="http://localhost/wiki.pl?action=translate;id=HomePage;missing=fr"]');
'//div[@class="footer"]/span[@class="translation bar"]/a[@class="translation new"][text()="Add Translation"][@href="http://localhost/wiki.pl?action=translate;id=HomePage;missing=fr"]');
test_page(get_page('action=translate id=HomePage target=PagePrincipale translation=fr'),
'Editing PagePrincipale');
@@ -129,8 +129,8 @@ test_page(update_page('Testing', 'This is spam.'), 'This page does not exist');
test_page(update_page('Spam', 'Trying again.'), 'This page does not exist');
test_page(get_page('action=translate id=Spam target=Harmless translation=en'),
'Edit Denied',
'Regular expression "spam" matched "Spam" on this page');
'Regular expression "spam" matched on this page');
test_page(get_page('Spam'), 'This page does not exist');
test_page(get_page('action=translate id=Harmless target=Spam translation=en'),
'Edit Denied',
'Regular expression "spam" matched "Spam" on this page');
'Regular expression "spam" matched on this page');

173
wiki.pl
View File

@@ -1,5 +1,5 @@
#! /usr/bin/env perl
# Copyright (C) 2001-2023
# Copyright (C) 2001-2019
# Alex Schroeder <alex@gnu.org>
# Copyright (C) 2014-2015
# Alex Jakimenko <alex.jakimenko@gmail.com>
@@ -39,7 +39,6 @@ use B;
use CGI qw/-utf8/;
use CGI::Carp qw(fatalsToBrowser);
use File::Glob ':glob';
use List::Util qw(all max);
use Encode qw(encode_utf8 decode_utf8);
use sigtrap 'handler' => \&HandleSignals, 'normal-signals', 'error-signals';
local $| = 1; # Do not buffer output (localized for mod_perl)
@@ -162,7 +161,9 @@ our $CurrentLanguage = 'en'; # Language of error messages etc
our $LanguageLimit = 3; # Number of matches req. for each language
our $JournalLimit = 200; # how many pages can be collected in one go?
our $PageNameLimit = 120; # max length of page name in bytes
$DocumentHeader = "<!DOCTYPE html>\n<html>";
$DocumentHeader = qq(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN")
. qq( "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">\n)
. qq(<html xmlns="http://www.w3.org/1999/xhtml">);
our @MyFooters = (\&GetCommentForm, \&WrapperEnd, \&DefaultFooter);
# Checkboxes at the end of the index.
our @IndexOptions = ();
@@ -209,7 +210,7 @@ sub ReportError { # fatal!
my ($errmsg, $status, $log, @html) = @_;
InitRequest(); # make sure we can report errors before InitRequest
print GetHttpHeader('text/html', 'nocache', $status), GetHtmlHeader(T('Error')),
$q->start_div({class=>'error'}), $q->h1(QuoteHtml($errmsg)), @html, $q->end_div,
$q->start_div({class=>"error"}), $q->h1(QuoteHtml($errmsg)), @html, $q->end_div,
$q->end_html, "\n\n"; # newlines for FCGI because of exit()
WriteStringToFile("$TempDir/error", '<body>' . $q->h1("$status $errmsg") . $q->Dump) if $log;
map { ReleaseLockDir($_); } keys %Locks;
@@ -449,7 +450,7 @@ sub ApplyRules {
if ($type eq 'text') {
print $q->pre({class=>"include $uri"}, QuoteHtml(GetRaw($uri)));
} else { # never use local links for remote pages, with a starting tag
print $q->start_div({class=>'include'});
print $q->start_div({class=>"include"});
ApplyRules(QuoteHtml(GetRaw($uri)), 0, ($type eq 'with-anchors'), undef, 'p');
print $q->end_div();
}
@@ -515,7 +516,7 @@ sub ApplyRules {
Clean(CloseHtmlEnvironments() . AddHtmlEnvironment('p')); # another one like this further up
} elsif (m/\G&amp;([A-Za-z]+|#[0-9]+|#x[A-Za-f0-9]+);/cg) { # entity references
Clean("&$1;");
} elsif (m/\G[ \t\r\n]+/cg) { # don't use \s because we want to honor NO-BREAK SPACE etc
} elsif (m/\G\s+/cg) {
Clean(' ');
} elsif (m/\G([A-Za-z\x{0080}-\x{fffd}]+([ \t]+[a-z\x{0080}-\x{fffd}]+)*[ \t]+)/cg
or m/\G([A-Za-z\x{0080}-\x{fffd}]+)/cg or m/\G(\S)/cg) {
@@ -665,7 +666,7 @@ sub OpenHtmlEnvironment { # close the previous $html_tag and open a new one
@HtmlStack = @stack if $found; # if not starting a new list
$depth = $IndentLimit if $depth > $IndentLimit; # requested depth 0 makes no sense
$html_tag_attr = qq/class="$html_tag_attr"/ # backwards-compatibility hack: classically, the third argument to this function was a single CSS class, rather than string of HTML tag attributes as in the second argument to the "AddHtmlEnvironment" function. To allow both sorts, we conditionally change this string to 'class="$html_tag_attr"' when this string is a single CSS class.
if $html_tag_attr and $html_tag_attr !~ m/=/;
if $html_tag_attr and $html_tag_attr !~ m/^\s*[[:alpha:]]@@+\s*=\s*('|").+\1/;
splice(@HtmlAttrStack, 0, @HtmlAttrStack - @HtmlStack); # truncate to size of @HtmlStack
foreach ($found .. $depth - 1) {
unshift(@HtmlStack, $html_tag);
@@ -801,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))/eig;
return decode_utf8($str) if $str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eg;
return $str;
}
@@ -876,13 +877,17 @@ sub PrintAllPages {
next if $lang and @languages and not grep(/$lang/, @languages);
next if PageMarkedForDeletion();
next if substr($Page{text}, 0, 10) eq '#REDIRECT ';
print '<article class="h-entry">', $q->h1({-class => 'p-name'},
$links ? GetPageLink($id) : $q->a({-name=>$id}, UrlEncode(FreeToNormal($id))));
print $q->start_div({-class=>'page h-entry'}),
$q->h1({-class => 'entry-title'},
$links ? GetPageLink($id) : $q->a({-name=>$id}, UrlEncode(FreeToNormal($id))));
if ($variation ne 'titles') {
my $lang = (split /,/, $Page{languages})[0] || $CurrentLanguage;
print $q->start_div({-class=>'entry-content', -lang=>$lang});
PrintPageHtml();
print $q->end_div();
PrintPageCommentsLink($id, $comments);
}
print '</article>';
print $q->end_div();
$n++; # pages actually printed
}
return $i;
@@ -1130,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, -loading=>'lazy'});
return $q->img({-src=>$url, -alt=>$url, -class=>$class});
} else {
return $q->a({-href=>$url, -class=>$class}, $text);
}
@@ -1219,8 +1224,7 @@ 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', -loading=>'lazy'});
my $result = $q->img({-src=>$action, -alt=>UnquoteHtml($alt), -title=>UnquoteHtml($alt), -class=>'upload'});
$result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
return $result;
} else {
@@ -1242,15 +1246,12 @@ sub PrintCache { # Use after OpenPage!
}
sub PrintPageHtml { # print an open page
return unless GetParam('page', 1) and $Page{text};
my $lang = (split /,/, $Page{languages})[0] || $CurrentLanguage;
print qq{<div class="e-content" lang="$lang">};
return unless GetParam('page', 1);
if ($Page{blocks} and defined $Page{flags} and GetParam('cache', $UseCache) > 0) {
PrintCache();
} else {
PrintWikiToHTML($Page{text}, 1); # save cache, current revision, no main lock
}
print '</div>';
}
sub PrintPageDiff { # print diff for open page
@@ -1279,6 +1280,7 @@ sub PageHtml {
return $error if $limit and length($diff) > $limit;
my $lang = (split /,/, $Page{languages})[0] // $CurrentLanguage;
my $page .= ToString \&PrintPageHtml;
$page = qq{<div class="page" lang="$lang">$page</div>} if $page;
return $diff . $q->p($error) if $limit and length($diff . $page) > $limit;
return $diff . $page;
}
@@ -1314,7 +1316,7 @@ sub GetId {
SetParam($p, 1); # script/p/q -> p=1
}
}
return FreeToNormal($id);
return $id;
}
sub DoBrowseRequest {
@@ -1544,34 +1546,28 @@ sub LatestChanges {
sub StripRollbacks {
my @result = @_;
if (not (GetParam('all', $ShowAll) or GetParam('rollback', $ShowRollbacks))) { # strip rollbacks
my (%rollback); # used for single-page rollbacks
my (%rollback);
for (my $i = $#result; $i >= 0; $i--) {
# some fields have a different meaning if looking at rollbacks
my ($ts, $id, $target_ts, $target_id) = @{$result[$i]};
# if this is a rollback marker
if ($id eq '[[rollback]]') {
# if this is a single page rollback marker, strip it
if ($target_id) {
# if this page is not already being rolled back, remember the target
# id and target ts so that those lines can be stripped below
if (not $rollback{$target_id} or $target_ts < $rollback{$target_id}) {
$rollback{$target_id} = $target_ts;
}
# the marker is always stripped
splice(@result, $i, 1);
$rollback{$target_id} = $target_ts; # single page rollback
splice(@result, $i, 1); # strip marker
} else {
# if this is a global rollback, things are different: we're going to
# find the correct timestamp and strip all of those lines immediately
my $end = $i;
$i-- while $i > 0 and $target_ts < $result[$i-1][0];
# splice the lines found
splice(@result, $i, $end - $i + 1);
while ($ts > $target_ts and $i > 0) {
$i--; # quickly skip all these lines
$ts = $result[$i][0];
}
splice(@result, $i + 1, $end - $i);
$i++; # compensate $i-- in for loop
}
} elsif ($rollback{$id} and $ts > $rollback{$id}) {
splice(@result, $i, 1); # strip rolled back single pages
}
}
} else { # if rollbacks are not not shown, just strip the markers
} else { # just strip the marker left by DoRollback()
for (my $i = $#result; $i >= 0; $i--) {
splice(@result, $i, 1) if $result[$i][1] eq '[[rollback]]'; # id
}
@@ -1719,11 +1715,6 @@ sub RcOtherParameters {
return $more;
}
sub RcSelfWebsite {
my $action = 'rc';
return "action=$action" . RcOtherParameters(qw(from upto days));
}
sub RcSelfAction {
my $action = GetParam('action', 'rc');
return "action=$action" . RcOtherParameters(qw(from upto days));
@@ -1869,7 +1860,7 @@ sub RcTextRevision {
$summary = GetPageContent($id) if GetParam('full', 0);
print "\n", RcTextItem('title', NormalToFree($id)),
RcTextItem('description', $summary),
RcTextItem('generator', GetAuthor($username, $host)),
RcTextItem('generator', GetAuthor($username)),
RcTextItem('language', join(', ', @{$languages})), RcTextItem('link', $link),
RcTextItem('last-modified', TimeToW3($ts)),
RcTextItem('revision', $revision),
@@ -1886,11 +1877,11 @@ sub PrintRcText { # print text rss header and call ProcessRcLines
sub GetRcRss {
my $date = TimeToRFC822($LastUpdate);
my @excluded = ();
my %excluded = ();
if (GetParam("exclude", 1)) {
foreach (split(/\n/, GetPageContent($RssExclude))) {
if (/^ ([^ ]+)[ \t]*$/) { # only read lines with one word after one space
push(@excluded, $1);
$excluded{$1} = 1;
}
}
}
@@ -1910,7 +1901,7 @@ sub GetRcRss {
};
my $title = QuoteHtml($SiteName) . ': ' . GetParam('title', QuoteHtml(NormalToFree($HomePage)));
$rss .= "<title>$title</title>\n";
$rss .= "<link>$ScriptName?" . RcSelfWebsite() . "</link>\n";
$rss .= "<link>$ScriptName?" . RcSelfAction() . "</link>\n";
$rss .= qq{<atom:link href="$ScriptName?} . RcSelfAction() . qq{" rel="self" type="application/rss+xml" />\n};
$rss .= qq{<atom:link href="$ScriptName?} . RcPreviousAction() . qq{" rel="previous" type="application/rss+xml" />\n};
$rss .= qq{<atom:link href="$ScriptName?} . RcLastAction() . qq{" rel="last" type="application/rss+xml" />\n};
@@ -1930,14 +1921,14 @@ sub GetRcRss {
$rss .= "<image>\n";
$rss .= "<url>$RssImageUrl</url>\n";
$rss .= "<title>$title</title>\n"; # the same as the channel
$rss .= "<link>$ScriptName?" . RcSelfWebsite() . "</link>\n"; # the same as the channel
$rss .= "<link>$ScriptName?" . RcSelfAction() . "</link>\n"; # the same as the channel
$rss .= "</image>\n";
}
my $limit = GetParam("rsslimit", 15); # Only take the first 15 entries
my $count = 0;
ProcessRcLines(sub {}, sub {
my $id = shift;
return if grep { $id =~ /$_/ } @excluded or ($limit ne 'all' and $count++ >= $limit);
return if $excluded{$id} or ($limit ne 'all' and $count++ >= $limit);
$rss .= "\n" . RssItem($id, @_);
});
$rss .= "</channel>\n</rss>\n";
@@ -2225,16 +2216,11 @@ sub ScriptLinkDiff {
return ScriptLink($action, $text, 'diff');
}
sub Code {
sub ColorCode {
my ($str) = @_;
my $num = unpack("L",B::hash($str)); # 32-bit integer
my $code = sprintf("%o", $num); # octal is 0-7
return substr($code, 0, 4); # four numbers
}
sub ColorCode {
my $code = Code(@_);
my @indexes = split(//, $code); # four numbers
my @indexes = split(//, substr($code, 0, 4)); # 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[$_]}, $_) }
@@ -2242,10 +2228,9 @@ sub ColorCode {
}
sub GetAuthor {
my ($username, $host) = @_;
my ($username) = @_;
return $username if $username;
return T('Anonymous') if $host eq 'Anonymous';
return Code($host);
return T('Anonymous');
}
sub GetAuthorLink {
@@ -2294,12 +2279,12 @@ sub GetHeader {
sub GetHeaderDiv {
my ($id, $title, $oldId, $embed) = @_;
my $result .= '<header>';
my $result .= $q->start_div({-class=>'header'});
if (not $embed and $LogoUrl) {
my $url = $IndexHash{$LogoUrl} ? GetDownloadLink($LogoUrl, 2) : $LogoUrl;
$result .= ScriptLink(UrlEncode($HomePage), $q->img({-src=>$url, -alt=>T('[Home]'), -class=>'logo'}), 'logo');
}
$result .= '<nav>';
$result .= $q->start_div({-class=>'menu'});
if (GetParam('toplinkbar', $TopLinkBar) != 2) {
$result .= GetGotoBar($id);
if (%SpecialDays) {
@@ -2311,10 +2296,10 @@ sub GetHeaderDiv {
}
}
$result .= GetSearchForm() if GetParam('topsearchform', $TopSearchForm) != 2;
$result .= '</nav>';
$result .= $q->end_div();
$result .= $q->div({-class=>'message'}, $Message) if $Message;
$result .= GetHeaderTitle($id, $title, $oldId);
$result .= '</header>';
$result .= $q->end_div();
return $result;
}
@@ -2462,7 +2447,7 @@ sub WrapperEnd { # called via @MyFooters
sub DefaultFooter { # called via @MyFooters
my ($id, $rev, $comment, $page) = @_;
my $html = $q->hr();
my $html = $q->start_div({-class=>'footer'}) . $q->hr();
$html .= GetGotoBar($id) if GetParam('toplinkbar', $TopLinkBar) != 1;
$html .= GetFooterLinks($id, $rev);
$html .= GetFooterTimestamp($id, $rev, $page);
@@ -2473,7 +2458,8 @@ sub DefaultFooter { # called via @MyFooters
}
$html .= T($FooterNote) if $FooterNote;
$html .= $q->p(Ts('%s seconds', (time - $Now))) if GetParam('timing', 0);
return "<footer>$html</footer>";
$html .= $q->end_div();
return $html;
}
sub GetFooterTimestamp {
@@ -2564,37 +2550,31 @@ sub GetFormStart {
}
sub GetSearchForm {
my $html = GetFormStart(undef, 'get', 'search');
my $replacing = (GetParam('search') ne '' and UserIsAdmin());
$html .= $q->start_p({-class => ($replacing ? 'replace' : 'search')});
$html .= $q->span({-class=>'search'},
$q->label({-for=>'search'}, T('Search:')) . ' '
. $q->textfield(-name=>'search', -id=>'search', -size=>15, -accesskey=>T('f'))) . ' ';
if ($replacing) { # see DoBrowseRequest
$html .= $q->span({-class=>'replace'},
$q->label({-for=>'replace'}, T('Replace:')) . ' '
. $q->textfield(-name=>'replace', -id=>'replace', -size=>20)) . ' '
. $q->span({-class=>'delete'},
$q->label({-for=>'delete', -title=>'If you want to replace matches with the empty string'}, T('Delete')) . ' '
. $q->input({-type=>'checkbox', -name=>'delete'})) . ' '
. $q->submit('preview', T('Preview')) . ' ';
my $html = GetFormStart(undef, 'get', 'search') . $q->start_p;
$html .= $q->label({-for=>'search'}, T('Search:')) . ' '
. $q->textfield(-name=>'search', -id=>'search', -size=>15, -accesskey=>T('f')) . ' ';
if (GetParam('search') ne '' and UserIsAdmin()) { # see DoBrowseRequest
$html .= $q->label({-for=>'replace'}, T('Replace:')) . ' '
. $q->textfield(-name=>'replace', -id=>'replace', -size=>20) . ' '
. $q->label({-for=>'delete', -title=>'If you want to replace matches with the empty string'}, T('Delete')) . ' '
. $q->input({-type=>'checkbox', -name=>'delete'})
. $q->submit('preview', T('Preview'));
}
if (GetParam('matchingpages', $MatchingPages)) {
$html .= $q->span({-class=>'match'},
$q->label({-for=>'matchingpage'}, T('Filter:')) . ' '
. $q->textfield(-name=>'match', -id=>'matchingpage', -size=>15)) . ' ';
$html .= $q->label({-for=>'matchingpage'}, T('Filter:')) . ' '
. $q->textfield(-name=>'match', -id=>'matchingpage', -size=>15) . ' ';
}
if (%Languages) {
$html .= $q->span({-class=>'lang'},
$q->label({-for=>'searchlang'}, T('Language:')) . ' '
. $q->textfield(-name=>'lang', -id=>'searchlang', -size=>5, -default=>GetParam('lang', ''))) . ' ';
$html .= $q->label({-for=>'searchlang'}, T('Language:')) . ' '
. $q->textfield(-name=>'lang', -id=>'searchlang', -size=>5, -default=>GetParam('lang', '')) . ' ';
}
$html .= $q->submit('dosearch', T('Go!')) . $q->end_p . $q->end_form;
return $html;
}
sub GetGotoBar { # ignore $id parameter
return $q->span({-class=>'gotobar bar'}, (map { GetPageLink($_) } @UserGotoBarPages), $UserGotoBar);
sub GetGotoBar { # ignore $id parameter
return $q->span({-class=>'gotobar bar'}, (map { GetPageLink($_) }
@UserGotoBarPages), $UserGotoBar);
}
# return list of summaries between two revisions, assuming the open page is the upper one
@@ -3375,7 +3355,7 @@ sub SortIndex {
sub DoIndex {
my $raw = GetParam('raw', 0);
my $limit = GetParam('n', '');
my $match = GetParam('match', '');
my @pages = ();
my @menu = ($q->label({-for=>'indexmatch'}, T('Filter:')) . ' '
. $q->textfield(-name=>'match', -id=>'indexmatch', -size=>20));
@@ -3386,9 +3366,8 @@ sub DoIndex {
push(@pages, $sub->()) if $value;
push(@menu, $q->checkbox(-name=>$option, -checked=>$value, -label=>$text));
}
@pages = Matched(GetParam('match', ''), @pages);
@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 {
@@ -3559,23 +3538,11 @@ sub SearchTitleAndBody {
return @found;
}
# Filter the pages to be searched for $string. The default implementation
# ignores $string and uses $match instead, just in case the user used both
# search and match parameters. This is overwritten in extensions such as tags.pl
# which extract tags from $string and use that to filter the pages.
sub Filtered {
sub Filtered { # this is overwriten in extensions such as tags.pl
my ($string, @pages) = @_;
return Matched(GetParam('match', ''), @pages);
}
sub Matched { # strictly for page titles
my ($string, @pages) = @_;
return @pages unless $string;
my @terms = grep { $_ } split(/[ _]+/, $string);
return grep {
my $id = $_;
all { $id =~ /$_/i } @terms;
} @pages;
my $match = GetParam('match', '');
@pages = grep /$match/i, @pages if $match;
return @pages;
}
sub SearchString {