Compare commits

..

159 Commits
2.3.14 ... main

Author SHA1 Message Date
Alex Schroeder
aba9fcfa40 [post-instead-of-get] use utf8 2025-07-25 19:24:18 +02:00
Alex Schroeder
16eb72c8db [post-instead-of-get] Fix link to "View all changes" 2025-07-25 18:58:48 +02:00
Alex Schroeder
4f99e2c4bd Fix README markup 2025-07-25 16:06:10 +02:00
Alex Schroeder
0b993a002a [post-instead-of-get] Change filter in DoIndex 2025-07-16 17:43:53 +02:00
Alex Schroeder
f5cb40d21c [post-instead-of-get] Change More... link in RcHtml 2025-07-16 17:17:50 +02:00
Alex Schroeder
97bc55bef3 [post-instead-of-get] Add back RcHeader
Just print the subheading.
2025-07-15 11:51:00 +02:00
Alex Schroeder
a30f9bb40c [post-instead-of-get] Fix list later changes form 2025-07-15 11:50:36 +02:00
Alex Schroeder
35c04beb2a [post-instead-of-get] Fix copyright 2025-07-15 11:38:59 +02:00
Alex Schroeder
c7a37261d1 [post-instead-of-get] Fix checkboxes
Use -checked correctly. Make label clickable by adding an id to the
checkboxes. Put the space inside the label.
2025-07-15 11:20:29 +02:00
Alex Schroeder
64bc459a3e [post-instead-of-get] Add line break
Add a linebreak before the Go! button the on the RecentChanges search
filter form.
2025-07-15 11:00:00 +02:00
Alex Schroeder
c7e563d02f CSS changes from 2020 2025-07-15 10:57:44 +02:00
Alex Schroeder
d489281f5c [post-instead-of-get] New module 2025-07-15 10:52:20 +02:00
Alex Schroeder
cc7240dc98 [nosearch] no class, no GET
Don't wrap the title in a span with extra stuff.

Don't use GET requests for the backlink search.
2025-07-15 10:52:20 +02:00
Alex Schroeder
726dfc2d5d Don't use List::Util "all" 2025-07-15 10:52:20 +02:00
Alex Schroeder
23e1cceead Ignore .vscode 2025-06-25 00:28:41 +02:00
Alex Schroeder
6c3eb92fff Add webp to image extensions 2025-06-25 00:28:09 +02:00
Alex Schroeder
a3ef9c2040 Switch README to Markdown 2024-08-12 10:09:24 +02:00
Alex Schroeder
4e16082b70 New empty translation file 2023-11-21 11:35:13 +01:00
Alex Schroeder
6234b05a50 [usemod] Switch ISBN lookups to Wikipedia 2023-11-21 11:31:17 +01:00
Alex Schroeder
567ea8e0a8 Fix rollback-hang tests 2023-11-21 11:31:09 +01:00
Alex Schroeder
0974b7bbd8 wordcount: fix test 2023-10-25 18:42:25 +02:00
Alex Schroeder
f73d420957 markdown-rule: be more lenient
Don't just limit to full URL: accept any non-whitespace characters as
a link.
2023-10-25 18:40:43 +02:00
Alex Schroeder
17ef2aaf88 CapnDan tells me this line is missing at the end 2023-08-12 21:22:49 +02:00
Alex Schroeder
b70c8e8def Add rolblack marker stripping back in 2023-08-10 11:23:18 +02:00
Alex Schroeder
f8752e69bc Update years 2023-08-10 11:20:46 +02:00
Alex Schroeder
9d48f875a2 Fix rollback code 2023-08-08 16:31:09 +02:00
Alex Schroeder
39e9cea7b0 Add Matched sub
This allows the use of whitespace to separate terms when using page
matching. This seems more natural than requiring underscores to match
the space between words in a page title. So now, a page with id
"one_two" is matched by terms such as "one_two", "two_one", "one two"
and "two one" (notice the word order).
2023-08-08 14:59:53 +02:00
Alex Schroeder
e7b718f610 [network-blocker] Ignore missing file 2023-07-15 21:06:04 +02:00
Alex Schroeder
261aeccb3f [network-blocker] New module 2023-07-15 21:00:58 +02:00
Alex Schroeder
a09c846700 Fix a rollback issue
Without this fix, Oddmuse would enter an infinite loop if the list of
items to show began with a rollback tag.
2023-06-30 13:02:03 +02:00
Alex Schroeder
8dbede3813 Tarballs doesn't link to a latest.tar.gz 2023-06-21 22:05:16 +02:00
Alex Schroeder
89d9f27b2a [rename-pages] Close form 2023-05-29 20:24:55 +02:00
Alex Schroeder
f21f257c1b Fix parenthesis 2023-03-24 21:59:52 +01:00
Alex Schroeder
48916943a1 More spans for the search bar 2023-03-24 21:16:47 +01:00
Alex Schroeder
3b185e5521 Add some spans to the gotobar for better styling 2023-03-24 15:38:50 +01:00
Alex Schroeder
612af8f7fb Make feed link more flexible
The result is that feeds generated by journal-rss.pl contain a link to
the Recent Changes page instead of linking twice to the feed.
2023-02-27 14:12:15 +01:00
Alex Schroeder
dc9131e600 Fix translation-link.t 2023-02-27 14:12:04 +01:00
Alex Schroeder
99af4d984d Handle [an example](#foo "Title") 2023-02-17 17:16:23 +01:00
Alex Schroeder
88f4fe3b89 Whitespace 2023-02-17 17:16:02 +01:00
Sandra Snan
851f2f77e8 Handle image/right
Everyone loves hacky regexes♥
2023-02-17 17:14:24 +01:00
Alex Schroeder
975e15c9f8 Don't turn all whitespace into a space
We want to honor NO-BREAK SPACE and the like!
2022-08-26 13:42:35 +02:00
Alex Schroeder
d235d6ac47 GetId returns the normal form of $id.
This means, "2022-07-15 The Joy of Exploration", which arrives as
"2022-07-15%20The%20Joy%20of%20Exploration", gets turned into
"2022-07-15_The_Joy_of_Exploration". The problem is that when posting,
$id = FreeToNormal(shift), so pages are always written to the page
with underscores. If you then request the raw history of a page,
however, no such call was happening and so no keep files were found by
DoHistory.
2022-07-18 17:51:22 +02:00
Alex Schroeder
f0d0942bfb namespaces: remove underscore from page title 2022-04-15 10:15:00 +02:00
Alex Schroeder
cd9246ebed Add Cooklang extension 2021-11-06 20:32:02 +01:00
Alex Schroeder
f7b23d854f ban-contributors: test Net::IP use 2021-09-29 19:52:12 +02:00
Alex Schroeder
104a1395e7 ban-contributors: use Net::IP to parse CIDR
whois 191.101.31.160 doesn't return a range, only something like
inetnum: 191.101.0.0/16
2021-09-29 18:17:58 +02:00
Alex Schroeder
ceb4c3a9cc Release process: master → main 2021-09-25 16:41:21 +02:00
Alex Schroeder
536757e8e2 ban-contributors: fix get_range
For 8.21.11.127 we have to issues: the key in the result set is
netrange and not inetnum, and the result for netrange is a list of
ranges and not just a single range. The new code no longer presumes to
know the keys. It just goes through all of them, trying to find
something that looks like a range. When it finds an array reference,
it goes through each entry, looking for a range. The first key where
are least one range is found is returned, with all the ranges for that
key, in our case that would be 8.0.0.0 - 8.127.255.255 and 8.21.11.0 -
8.21.11.255.

The ban-contributors code then presents two forms, one for each match.
2021-09-25 16:17:37 +02:00
Alex Schroeder
00af1aa638 New CSS 2021-09-19 23:01:59 +02:00
Alex Schroeder
c2cf3e7b43 namespaces: reload @IndexList before saving
Without this commit, what used to happen is that if ban-contributors
banned a contributor in a namespace, the pageidx of the main space got
overwritten with the pageidx of the namespace: since the values of
@IndexList and %IndexHash remained unchanged.
2021-09-12 18:34:04 +02:00
Alex Schroeder
05c14d37b2 ban-contributors: another regexp improvement 2021-09-09 22:33:41 +02:00
Alex Schroeder
fc3614f291 ban-contributors: improved the IP regex generator
I did not want to use Number::Range::Regex because those regular
expressions are somewhat hard to read, so instead some test cases from
actual spammers were added and the code rewritten to be easier to
understand. It should now also be obvious when it breaks.
2021-09-04 23:39:07 +02:00
Alex Schroeder
e201c77696 namespaces: share BannedContent and BannedHosts
New approach: save the original value of $DataDir in
$NamespacesRootDataDir. When reading the value of $BannedHosts or
$BannedContent via GetPageContent in UserIsBanned or BannedContent,
and in DoBanHosts for ban-contributors.pl, use the root data dir; when
saving $BannedHosts or $BannedContent via DoPost, use the root data
dir.
2021-08-28 00:51:15 +02:00
Alex Schroeder
f280cb5df4 Revert "namespaces: share BannedContent and BannedHosts"
This reverts commit 29863d7109.
2021-08-28 00:09:34 +02:00
Alex Schroeder
29863d7109 namespaces: share BannedContent and BannedHosts
To facilitate spamfighting, the namespace is not set when the current
action refers to one of the page ids in the @NamespaceIgnored list.
The default value for these is $BannedContent and $BannedHosts, in
other words, the pages 'BannedContent' and 'BannedHosts'.
2021-08-26 23:52:58 +02:00
Alex Schroeder
b514ea7846 Fix TRANSLATIONS glob in the Makefile
The current code always resulted in an empty list of files for
TRANSLATIONS; the did not end up in the build directory; and they did
not get installed elsewhere.
2021-08-08 09:10:38 +02:00
Tobias Fendin
eeaf615d3b Added more swedish translations 2021-08-08 08:56:20 +02:00
Tobias Fendin
f003481c5e Translated webmention to swedish 2021-08-08 08:56:14 +02:00
Alex Schroeder
4d10ef389a Add script/unsusbscribe.pl
Mail subscriptions for blog posts that are many years old make no
sense to me. Here's a script to purge those old subscriptions.
2021-08-02 15:50:33 +02:00
Alex Schroeder
726ffdced1 banned-regexps: do not remove URLs from the text
If we want to match borked spam like <a href=http://example> then it's
counterproductive if we remove the URLs because our pattern will have
to be "href=" instead of "href=http". Also it's hard to remember that
URLs are removed.
2021-07-21 15:15:05 +02:00
Alex Schroeder
18c4071da8 t/test: handle spaces in PERLBREW_PATH
When running under the fish shell, PERLREW_PATH contains two
directories separated by a space.
2021-07-13 15:10:53 +02:00
Alex Schroeder
fd7fa0c3ab Add progress indicator to stats 2021-07-13 15:09:21 +02:00
Alex Schroeder
2ba5b72242 stats.pl is a new script to print some stats for a page dir 2021-07-13 14:57:38 +02:00
Alex Schroeder
fa5a2f7a1a rc2mail: print $root
When sending mails for multiple wikis, it's important to show for what
wiki the mails were sent, given that the user asked us to be verbose.
2021-07-13 10:38:35 +02:00
Alex Schroeder
ad042630b6 ban-contributors: fix regexp generator
The code would often prematurely end a regular expression with $.
2021-07-13 10:38:35 +02:00
Alex Schroeder
9cf35b9b52 Updated Swedish translation 2021-07-09 23:40:48 +02:00
Alex Schroeder
4f69103b8c wiki: simplify a regular expression
In OpenHtmlEnvironment we simplyfy the regular expression that is
supposed to detect whether this is a class assignment to a simple
check whether the attribute contains an equal sign.
2021-03-26 15:59:56 +01:00
Alex Schroeder
37c882780a emoji: add \b after :p
This prevents something like time:prime to trigger the emoji
replacement.
2021-03-26 15:58:15 +01:00
Alex Schroeder
6d5f97e1ba journal-rss: fix headers for raw output 2021-02-20 11:17:56 +01:00
Alex Schroeder
4b1063c699 journal-rss: add one more test 2021-02-20 10:18:24 +01:00
Alex Schroeder
b891674a6f journal-rss: support raw mode 2021-02-20 09:51:31 +01:00
Alex Schroeder
1a65df6e36 Update the French translation
Submitted by pierre. Thank you very much!
2021-01-04 23:03:22 +01:00
Alex Schroeder
6043be852c Fix handling of $RssExclude
It contains a list of regular expressions, not of page names.
2020-12-09 12:39:03 +01:00
Alex Schroeder
bb11bdf789 Updated the tests for HTML5
All tests successful.
Files=153, Tests=3483, 128 wallclock secs ( 0.85 usr  0.22 sys + 228.35 cusr 26.61 csys = 256.03 CPU)
Result: PASS

All right!! 😁
2020-10-29 17:02:19 +01:00
Alex Schroeder
540fd588c9 Incompatible HTML changes
Trying to get more HTML5 elements used.

PrintAllPages:

Use the article element instead of a div with class "page". The new
article element still has the "h-entry" class that the old div had.

The h1 element for these pages used to have the class "entry-title"
which is apparently deprecated. The new code now uses the "p-name"
attribute.

The page content is no longer surrounded in a div with the
"entry-content" class and the appropriate lang attribute. We rely on
PrintPageHtml to do the right thing, now.

PrintPageHtml:

Surround the page being printed with a div containing the "e-content"
class and an appropriate lang attribute.

PageHtml:

This also uses PrintPageHtml and therefore doesn't need to surround
the page content with a div containing the "page" class and the lang
attribute.

As PageHtml is used in RSS feed generation, that means that the feed
entries now don't have a div containing the "page" class but a div
containing the "e-content" class.

GetHeaderDiv:

Instead of using a div with the "header" class, use the header
element.

Instead of using a div with the "menu" class, use the nav element.

PrintPageContent:

No changes! We're not changing the div here because the content that
is being printed here does not belong into an article element. It is
not "a self-contained composition in a … page … intended to be
independently distributable or reusable" – it *is* the page
itself (without the h1 header).

PrintFooter:

Use an additional footer element.

DefaultFooter:

Remove the div with the "footer" class.

References:

* http://microformats.org/wiki/h-entry
* https://developer.mozilla.org/en-US/docs/Web/HTML/Element/header
* https://developer.mozilla.org/en-US/docs/Web/HTML/Element/nav
* https://developer.mozilla.org/en-US/docs/Web/HTML/Element/article
* https://developer.mozilla.org/en-US/docs/Web/HTML/Element/footer
2020-10-27 21:34:02 +01:00
Alex Schroeder
278fad1f43 Fixed development target in Makefile
The problem is that by default the test-data/config file contains
$ScriptName = 'http://localhost/wiki.pl' but morbo serves the site at
http://127.0.0.1:8080. We therefore append a new $ScriptName
assignment if the correct one doesn't exist. The alternative is
tricky because of the /wiki.pl prefix; fixing that would require a lot
more code, I suspect.
2020-10-25 10:31:36 +01:00
Alex Schroeder
eadeb460f5 Fixed tests
DuckDuckGo search doesn't use the www subdomain anymore.

The raw recent changes returns the bogus hash (four octal digits)
instead of Anonymous before maintenance anonymises the entry.
2020-08-12 21:09:28 +02:00
Alex Schroeder
5da9ce64c0 Lazy loading of images
Use the new loading="lazy" attribute for images.
2020-08-12 20:53:58 +02:00
Alex Schroeder
40498b53f7 duckduckgo-search: no www subdomain
Use duckduckgo.com intead of www.duckduckgo.com.
2020-07-29 09:09:42 +02:00
Alex Schroeder
eaf97602ff Make sure the bogus hash is served for raw changes
When serving recent changes, we know the username and host of the
person making the edit. We use GetAuthorLink to show either the name
linked to the username, or "Anonymous", or a colour coded bogus hash
of their host (that's the four octal digits, hopefully colourized by
your CSS).

When serving raw changes, we used to serve just the username or
"Anonymous". In order to help use cases such as the Gemini wiki
running on gemini://alexschroeder.ch:1965 which consumes raw changes
to present a view that is compatible with Gemini Wiki, we'd like those
bogus hashes as well. This comit does that by splitting ColorCode into
Code and ColorCode such that we can use Code when serving raw changes.
2020-07-23 11:49:42 +02:00
Alex Schroeder
987c262425 wiki: add n limit to index action
Useful when retrieving the latest blog pages from a wiki using raw=1.
2020-07-16 18:11:25 +02:00
Alex Schroeder
c33ee0a9e6 markdown-rule: add one more test 2020-07-13 11:26:25 +02:00
Alex Schroeder
eb7665661f gemini-server: handle Gemini markup
Up to now it was assumed that the raw wiki text would not be written
as Gemtext, but increasingly that is not the case. This commit adds
handling of Gemtext links.
2020-07-12 13:02:02 +02:00
Alex Schroeder
72ae1bf56f gemini-server: fix month in Atom date 2020-07-03 13:41:24 +02:00
Alex Schroeder
8f30ed8109 gemini-server: don't require a space after URL 2020-07-02 17:34:43 +02:00
Alex Schroeder
19e71f1180 gemini-server: clean up feed generation
Reorganize the code a little bit, removing some useless statements.
Make sure it workes with the journal-rss.pl module. Add tests.
2020-07-01 10:34:45 +02:00
Alex Schroeder
9397a38394 gemini-server: add RSS and Atom feeds 2020-06-30 22:48:54 +02:00
Alex Schroeder
17bd2d08cd gemini-server: small updates
gemini_link now handles URLs and is used for all links in
serve_gemini_page.

Paragraph splits now happen at the beginning of list items and when
line breaks are requested. It's not great but what else are you going
to do?

Handle image links.

Handle HTML tags (by ignoring them).

Raw pages served as text/plain instead of text/markdown.
2020-06-22 09:04:39 +02:00
Alex Schroeder
47a5e81000 Run extension even if testing
That is, run the gemini_config file before surge protection!
2020-06-17 23:34:37 +02:00
Alex Schroeder
7bfe740fb2 gemini-server: add language support 2020-06-16 23:08:22 +02:00
Alex Schroeder
6a324b59b9 gemini-server: move run_extensions to the top 2020-06-16 00:08:08 +02:00
Alex Schroeder
23545006a5 gemini-server: add diff support 2020-06-15 20:13:39 +02:00
Alex Schroeder
65012eacbb gemini-server: add history page support
Makefile now also has a gemini target to start up a gemini wiki. It
also calls openssl to generate keys if necessary.

gemini-server.pl now also has log messages in the various functions
serving content, instead of having some of them in the main function.
The footer is printed in a separate function.
2020-06-15 17:19:56 +02:00
Alex Schroeder
91107143f3 gemini-server: switching from gemini+write to titan 2020-06-14 12:34:43 +02:00
Alex Schroeder
cafda90555 gemini-server: various improvements
Render colours (from bbCode).

Serve HTML, including link from footer.

Fix escaping of code blocks.

Remove /m flag from most block substitutions.
2020-06-13 13:51:31 +02:00
Alex Schroeder
32dfec102d gemini-server: add support for a config file 2020-06-13 01:44:26 +02:00
Alex Schroeder
c1cdca5f95 gemini-server: more tests
Also chaged two more permanent redirects to temporary redirects.
2020-06-11 23:45:16 +02:00
Alex Schroeder
61dc928e33 gemini-server: write tests, fix bugs
Fixed sorting. Added \r to some of the links. Allow loading
gemini-server.pl as a library. Don't force the display of ten links in
the main menu unless we actually have as many day pages. Change URL
for minor recent changes.
2020-06-11 13:53:56 +02:00
Alex Schroeder
d43fe3fab9 gemini-server: more improvements
Fixed [URL text] and [[in-reply-to:URL|text]] patterns: don't pass an
URL to gemini_link!

Some log output when writing files. Don't double-decode UTF-8 when
writing text pages.

Render pages ending in '.txt' as raw text. No folding of robots.txt!

Fix two confusing calls to UrlEncode at the end: when serving Gemini
pages and raw text pages, don't URL-encode the page names, use
FreeToNormal to get valid page ids!
2020-06-08 21:34:44 +02:00
Alex Schroeder
3acb572c0d gemini-server: small improvements
Fiddle with the block parsing... Perhaps the single /\n\* / match is
unnecessary? Let's wait for a case where this is wrong. Basically that
would be a paragraph followed immediately by a list item
* like this

I don't think people write it like this when writing for the wiki.

Support the special case <journal search tag:foo> for tag pages.

Fix handling of newlines for blocks that are just links and the like.
2020-06-08 14:09:18 +02:00
Alex Schroeder
0f6787d349 gemini-server: use temporary redirects, always 2020-06-07 22:04:46 +02:00
Alex Schroeder
af287a1279 gemini-server: various improvements
No longer wrap paragraphs. In fact, unwrap paragraphs and list items
because that's what the specification says: Each line is to be wrapped
separately.

Allow single line/paragraph comments. This requires the QuestionAsker
extension and supports the questions and answers.

Support in-reply-to links. Support Markdown links.

Sort pages and their comments correctly even if not day pages.

Fix URL-encoding of $id whenever a URL is printed (for redirection
using 30 and 31, for example), and fix normal form (underscores
instead of spaces for $id).
2020-06-07 21:21:08 +02:00
Alex Schroeder
6bbd43f8a3 gemini-server: various improvements
Do not URL-escape the slash.

Reorganize the main menu and add a 'New page' link.

Change the tag format from $id/tag to tag/$id.

Change the naming so that "text page" is now a "raw page" served via
raw/$id.

Only allow editing of raw pages.

Improve transformation of wiki raw text to Gemini format. Handle tags
with alternate text and images.

Add a footer to Gemini format pages.

When editing existing pages, always make it a minor edit. That matches
how I use the wiki as a blog. It might not be correct for a wiki used
as an encyclopedia.

Handle spaces in $id.
2020-06-07 12:01:27 +02:00
Alex Schroeder
364d7c695b gemini-server: serve Gemini, best effort 2020-06-06 14:22:57 +02:00
Alex Schroeder
871af41881 gemini-server: add searching, matching, sorting 2020-06-05 23:19:03 +02:00
Alex Schroeder
4648bfbd83 wiki: make url-decoding case insensitive 2020-06-05 23:00:31 +02:00
Alex Schroeder
129d02850b gemini-server: answer with a redirect after saving 2020-06-05 13:16:45 +02:00
Alex Schroeder
ee23ef509c gemini-server: fix issues to allow writes
Remaining known problem: HTML output when an error occurs (and status
line at the end saying that everything went fine).
2020-06-05 00:54:58 +02:00
Alex Schroeder
7e865696b0 gemini-server: add write support 2020-06-04 19:59:27 +02:00
Alex Schroeder
244d06ca3b gemini-server: fix recent changes and rss 2020-05-31 19:40:51 +02:00
Alex Schroeder
1a59075b51 gemini-server: new 2020-05-31 00:34:59 +02:00
Alex Schroeder
e0b3c18499 mail: allow unsubscription from all pages
Fix unsubscription from all pages when no list of pages has been
provided: do not return early.
2020-05-27 08:36:34 +02:00
Alex Schroeder
5434136a4d mail: allow unsubscription from all pages
Simplify code. Fix display of email list: URL decoding email addresses
and printing the email addresses in the list. Fix the feedback message
after unsubscribing somebody from all pages.
2020-05-27 08:32:39 +02:00
Alex Schroeder
aeeb182dad mail: allow unsubscription from all pages
A new action (subscribers) also just lists email addresses to make
this easier.
2020-05-27 07:54:07 +02:00
Alex Schroeder
4d6882ffc7 ip-to-regexp.pl: new command line script
Helps to block entire IP blocks.
2020-05-27 07:51:56 +02:00
Alex Schroeder
828482f439 webmention: various updates
scripts/webmention.pl now extracts the author of FROM

modules/webmention.pl now is less complicated about skipping
webmention endpoint advertising and it tries to use the author and
link advertised from the incoming webmention page

And the tests were amended.
2020-05-03 21:09:30 +02:00
Alex Schroeder
2b6f2dfa0c pygmentize: add a test 2020-05-03 14:33:58 +02:00
Alex Schroeder
413b43174c webmention: avoid warning about CGI::param
We're using it in list context, now, and that generates a warning.
Using multi_param avoids this.
2020-05-03 11:49:19 +02:00
Alex Schroeder
9709c87185 webmention: better UI 2020-05-03 10:54:50 +02:00
Alex Schroeder
0cca358de2 webmention: add UI 2020-05-03 10:02:44 +02:00
Alex Schroeder
acff0cb69f Add tests for grep-filtered 2020-03-19 20:45:14 +01:00
Alex Schroeder
8d5956cb7f grep-filtered: old/new module 2020-03-19 14:07:59 +01:00
Alex Schroeder
e9773ea694 Add wordcount module 2020-02-06 14:01:33 +01:00
Alex Schroeder
7094ec098b stuff/server: fix UTF-8 encoding problem
Sadly, I would have thought that the correct solution is the
following, at the end, once we have $server:

$server->cgi_init(
  sub {
    require CGI;
    CGI::initialize_globals();
    CGI->import(qw(-utf8));
  });

This is based on the documentation of HTTP::Server::Simple::CGI, and
skimming its source code, and the documentation of the use pragma, and
the pseudo code in its documentation. The workaround of setting
$CGI::PARAM_UTF8 directly is based on reading the CGI.pm source code.
This is definitely a hack.
2019-12-28 18:11:49 +01:00
Alex Schroeder
04fe4d6991 stuff/server: better instructions at the beginning 2019-12-28 13:59:55 +01:00
Alex Schroeder
570a6b1f07 stuff/server: use ./wiki.pl instead of wiki.pl 2019-12-28 13:45:19 +01:00
Alex Schroeder
4211d6aa03 definition-lists: new 2019-10-14 22:36:32 +02:00
Alex Schroeder
5941fcd7e6 recaptcha: fix tests
check_answer_v2 requires an answer or it throws the error "To check
answer, the user response token must be provided". That causes all the
tests to fail. Thus, if no answer is provided, we return 0 (false).
2019-10-06 18:04:44 +02:00
Alex Schroeder
f3df2eb289 Merge pull request #21 from fancypantalons/master
Switch to reCAPTCH v2 API.
2019-10-06 09:00:03 +02:00
Brett Kosinski
8b975cd5e5 Switch to reCAPTCH v2 API.
The v1 API has been deprecated, so this changeset switches to using the
v2 API as exposed by the Captch::reCAPTCHA module.

The main changes are to switch to the _v2 methods for get_html and
check_answer, plus necessary changes to the check_answer parameters to
make the code compatible with the new form field naming.
2019-10-05 19:37:27 -06:00
Alex Schroeder
850f292260 rc2mail: switch to Net::SMTP and Authen::SASL 2019-10-04 18:33:32 +02:00
Alex Schroeder
ced1252b9d new-utf8: new modules add new translations 2019-10-04 18:32:14 +02:00
Alex Schroeder
c0a6bfebf2 Add language to body element and various divs
The benefit is that this allows us to use the CSS rule that allows the
browser to hyphenate words:

body { hyphens: auto }

This required a number of changes.

wiki.pl

- new option, $CurrentLanguage
- GetHtmlHeader adds lang attribute to body
- PrintAllPages adds lang attribute to div
- PrintPageContent adds lang attribute to div
- PageHtml adds div with lang attribute
- GetLanguages sorts languages by occurences
- GetLanguage is new and returns the first language of GetLanguages

Modules that had to be changed because they refer to the divs that
have now been changed:

- crossbar.pl

Tests that had to be changed:

- atom.t
- crossbar.t
- hr.t
- languages.t
- portrait-support.t
- rss.t
2019-09-27 21:34:32 +02:00
Alex Schroeder
36815767f3 markdown-rule: allow to set text-align style 2019-09-19 10:38:47 +02:00
Alex Schroeder
2cba2d30b7 Makefile: add a morbo target
This makes it easy to quickly deploy the wiki standalone using
Mojolicious. It reloads automatically when any of the relevant files
are changed. This might be easier to work with than a local webserver
installation.
2019-07-16 23:02:10 +02:00
Alex Schroeder
fded17520c namespaces: add test for numerical namespaces 2019-07-16 22:58:43 +02:00
Alex Schroeder
46580a3958 gopher-server: fix linebreaks in links 2019-06-24 12:08:36 +02:00
Alex Schroeder
d584899447 markdown-rule: test removal of MarkdownExtraRule 2019-06-24 11:03:53 +02:00
Alex Schroeder
79c0a9fd02 gopher-server: fix test
The test didn't specify a host explicitly. On my systems, that meant
"localhost" sometimes ended up being "127.0.0.1" or "::1" but for
Alexine it ended up being "::ffff:127.0.0.1". Let's hope that
explicitly setting "127.0.0.1" fixes all of this.
2019-06-24 10:50:14 +02:00
Alex Schroeder
c3f21d60c2 markdown-rule: fix > block quoting 2019-06-24 10:29:02 +02:00
Alex Schroeder
43221ea8a9 markdown-rule: fix """ quotes 2019-06-24 10:19:33 +02:00
Alex Schroeder
25350e93cb markdown-rule: allow newlines in link text
Also added """ for blockquotes.
2019-06-21 23:51:50 +02:00
Alex Schroeder
415a8aa9a8 gopher-server: more links, more tests 2019-06-20 14:27:32 +02:00
Alex Schroeder
a3d740aa67 gopher-server: Gopher URLs can have no type 2019-06-20 12:35:04 +02:00
Alex Schroeder
1956335640 Support gophers URL scheme 2019-06-20 12:31:31 +02:00
Alex Schroeder
b89c8b99e8 Example configs for Mojolicious 2019-06-10 15:02:10 +02:00
Alex Schroeder
4e4d8ee784 Webmention: new feature
This deprecates pingback-server!
2019-05-24 21:43:25 +02:00
Alex Schroeder
7ecd7b784e t: updated copyright years 2019-05-08 08:01:54 +02:00
Alex Schroeder
0d9764b0de gopher-server: fix space normalisation in links 2019-05-04 18:33:36 +02:00
Alex Schroeder
5d7964977c tags: hide the taglist action 2019-04-13 19:33:36 +02:00
Alex Schroeder
d50cda9cea tags: add $TagCloudSize 2019-04-13 19:31:32 +02:00
Alex Schroeder
7257bfb6d5 tags.pl: use HTML::TagCloud to generate cloud 2019-04-13 19:21:55 +02:00
Alex Schroeder
f2470256ae server: fix shebang line with better env path 2019-04-13 19:21:55 +02:00
Alex Schroeder
3c7a56ba5a gopher-server: documentation in the README
And:

- fix typo in the comments of gopher-server.pl
- add log level 4 output to debug how the data directory is sets
2019-04-13 19:21:55 +02:00
Alex Schroeder
07d68b4400 journal-rss: fix tests 2019-03-20 12:12:08 +01:00
Alex Schroeder
51d2d3e0ca tarballs: support "latest" release 2019-03-19 14:50:43 +01:00
Alex Schroeder
0a361873de Fix RSS links in feed
Trying to fix all the issues the validator noticed.
2019-03-19 14:47:39 +01:00
Alex Schroeder
6af02a8a1e Fix quoting of RC and RSS link parameters
When generating RC and RSS link parameters, the values of the
parameters were not URL encoded. This is now fixed.
2019-03-19 14:46:29 +01:00
Alex Schroeder
dc283ea828 tarballs: use Sort::Versions 2019-03-02 14:44:36 +01:00
88 changed files with 5189 additions and 1067 deletions

1
.gitignore vendored
View File

@@ -9,3 +9,4 @@
wiki.log
.prove
TAGS
/.vscode/

View File

@@ -3,7 +3,7 @@
# subdirectory.
VERSION_NO=$(shell git describe --tags)
TRANSLATIONS=$(wildcard modules/translations/[a-z]*-utf8.pl$)
TRANSLATIONS=$(wildcard modules/translations/*-utf8.pl)
MODULES=$(sort $(wildcard modules/*.pl))
BUILD=build/wiki.pl $(foreach file, $(notdir $(MODULES)) $(notdir $(TRANSLATIONS)), build/$(file))
@@ -60,3 +60,21 @@ jobs ?= 4
test:
prove t/setup.pl
prove --jobs=$(jobs) --state=slow,save t
# 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

View File

@@ -1,197 +0,0 @@
This is the README file distributed together with the
[[https://oddmuse.org/|Oddmuse]] script.
== Installing Oddmuse on a Debian System running Apache
The following instructions require a number of tools. You can make sure
they're all installed by issuing the following command as {{{root}}}:
{{{
apt-get install coreutils apache2 sudo wget w3m perl \
libwww-perl libxml-rss-perl diffutils
}}}
You probably created an account for yourself. You might have to add this
user to the {{{sudo}}} group. Here's how I created my own user as
{{{root}}}:
{{{
adduser alex
usermod -a -G sudo alex
}}}
Now you can login as {{{alex}}} and do everything else using {{{sudo}}}.
You need to copy wiki.pl into your cgi-bin directory, and you need to
make the script executable. You might also have to change its owner to
an appropriate user on your system.
{{{
sudo wget -O /usr/lib/cgi-bin/wiki.pl \
http://git.savannah.gnu.org/cgit/oddmuse.git/plain/wiki.pl
sudo chmod +x /usr/lib/cgi-bin/wiki.pl
sudo chown www-data.www-data /usr/lib/cgi-bin/wiki.pl
}}}
If you're on SUSE, the user might not be {{{www-data}}} but
{{{wwwrun}}} without appropriate group:
{{{
sudo chown wwwrun.root /usr/lib/cgi-bin/wiki.pl
}}}
You should be able to test it right now! Visit
{{{http://localhost/cgi-bin/wiki.pl}}}. If your site is available from
the outside, you will be able to use a normal browser. If don't have a
domain name yet, you'll probably have to use a text browser like
{{{w3m}}}.
{{{
w3m http://localhost/cgi-bin/wiki.pl
}}}
If you create pages in this wiki, these will get stored in a temporary
directory. You need change the data directory from {{{"/tmp/oddmuse"}}}
to like {{{"/var/local/oddmuse"}}}. The best way to do this without
changing {{{wiki.pl}}} is by editing
{{{/etc/apache2/sites-available/default}}}. Add the following line:
{{{
SetEnv WikiDataDir /var/local/oddmuse
}}}
Enable the default site by calling the following command:
{{{
sudo a2ensite default
}}}
Reload the Apache configuration by calling the following command:
{{{
sudo service apache2 reload
}}}
You need to create the new data directory. You webserver runs CGI
scripts as {{{www-data}}}. Thus, you need to change the owner and group
of the directory to {{{www-data}}}.
{{{
sudo mkdir -p /var/local/oddmuse
sudo chown www-data.www-data /var/local/oddmuse
}}}
Done! Visit your wiki and start editing. Click on the edit link (the
first link below the navigation bar, at the bottom of the page). This
will allow you to enter some text for this page. Click the Save button
and you are done.
To add new pages, edit the homepage and add links to new pages by
putting their names in {{{[[double square brackets]]}}}.
Enjoy your wiki experience.
Visit https://www.oddmuse.org/ to learn more about the translation
files and modules that are part of this package.
== Checking the Apache Setup
If you think this information doesn't work for you, here are some things
to check.
Apache's config directory is {{{/etc/apache2/apache2.conf}}}. This is
where we get the {{{www-data}}} username from. It says:
{{{
# These need to be set in /etc/apache2/envvars
User ${APACHE_RUN_USER}
Group ${APACHE_RUN_GROUP}
}}}
Checking {{{/etc/apache2/envvars}}} we see the following:
{{{
export APACHE_RUN_USER=www-data
export APACHE_RUN_GROUP=www-data
}}}
So that's what we're using in the {{{chown}}} command in our
instructions above.
The default site is configured in
{{{/etc/apache2/sites-available/default}}}. In order for it to be
//enabled//, there must be a symlink from a file in
{{{/etc/apache2/sites-enabled}}} to the file in
{{{sites-available}}}. You can enable it using the following command:
{{{
sudo a2ensite default
}}}
This file also lists the directories we've used in our instructions
above.
{{{
ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/
}}}
This means that {{{http://localhost/cgi-bin/wiki.pl}}} will call
{{{/usr/lib/cgi-bin/wiki.pl}}}
Don't forget to reload the Apache configuration as shown above, or
simply restart it all:
{{{
sudo service apache2 graceful
}}}
== Using just Perl
You can use Mojolicious as your web server. There is a simple
##server.pl## which you can use. Here's how you might start it:
{{{
mkdir ~/oddmuse
WikiDataDir=$HOME/oddmuse perl server.pl daemon
}}}
This makes the server available on {{{http://localhost:3000/wiki}}}.
Make sure you create the directory before starting the server!
If you don't, you'll get a strange error:
`STDERR: : No such file or directory at ... perl5/Mojolicious/Plugin/CGI.pm`.
If it works, feel free to upgrade to Hypnotoad.
{{{
WikiDataDir=$HOME/oddmuse hypnotoad server.pl
}}}
Note: Hypnotoad uses a different default port. The above makes the
server available on {{{http://localhost:8080/wiki}}}. Hypnotoad will
keep forking new processes. To stop it, use the {{{-s}}} flag.
{{{
hypnotoad -s server.pl
}}}
== License
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
any later version published by the Free Software Foundation.
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 2 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.
Both the GNU Free Documentation License, and the GNU General Public
License are distributed together with this script. See the files
[[https://github.com/kensanata/oddmuse/blob/master/FDL|FDL]] and
[[https://github.com/kensanata/oddmuse/blob/master/GPL|GPL]],
respectively.

161
README.md Normal file
View File

@@ -0,0 +1,161 @@
This is the README file distributed together with the
[Oddmuse](https://oddmuse.org/) script.
## Installing Oddmuse on a Debian System running Apache
The following instructions require a number of tools. You can make sure
they're all installed by issuing the following command as `root`:
apt-get install coreutils apache2 sudo wget w3m perl \
libwww-perl libxml-rss-perl diffutils
You probably created an account for yourself. You might have to add this
user to the `sudo` group. Here's how I created my own user as `root`:
adduser alex
usermod -a -G sudo alex
Now you can login as `alex` and do everything else using `sudo`.
You need to copy wiki.pl into your cgi-bin directory, and you need to
make the script executable. You might also have to change its owner to
an appropriate user on your system.
sudo wget -O /usr/lib/cgi-bin/wiki.pl \
http://git.savannah.gnu.org/cgit/oddmuse.git/plain/wiki.pl
sudo chmod +x /usr/lib/cgi-bin/wiki.pl
sudo chown www-data.www-data /usr/lib/cgi-bin/wiki.pl
If you're on SUSE, the user might not be `www-data` but `wwwrun` without
appropriate group:
sudo chown wwwrun.root /usr/lib/cgi-bin/wiki.pl
You should be able to test it right now! Visit
`http://localhost/cgi-bin/wiki.pl`. If your site is available from the
outside, you will be able to use a normal browser. If don't have a
domain name yet, you'll probably have to use a text browser like `w3m`.
w3m http://localhost/cgi-bin/wiki.pl
If you create pages in this wiki, these will get stored in a temporary
directory. You need change the data directory from `"/tmp/oddmuse"` to
like `"/var/local/oddmuse"`. The best way to do this without changing
`wiki.pl` is by editing `/etc/apache2/sites-available/default`. Add the
following line:
SetEnv WikiDataDir /var/local/oddmuse
Enable the default site by calling the following command:
sudo a2ensite default
Reload the Apache configuration by calling the following command:
sudo service apache2 reload
You need to create the new data directory. You webserver runs CGI
scripts as `www-data`. Thus, you need to change the owner and group of
the directory to `www-data`.
sudo mkdir -p /var/local/oddmuse
sudo chown www-data.www-data /var/local/oddmuse
Done! Visit your wiki and start editing. Click on the edit link (the
first link below the navigation bar, at the bottom of the page). This
will allow you to enter some text for this page. Click the Save button
and you are done.
To add new pages, edit the homepage and add links to new pages by
putting their names in `[[double square brackets]]`.
Enjoy your wiki experience.
Visit <https://www.oddmuse.org/> to learn more about the translation
files and modules that are part of this package.
## Checking the Apache Setup
If you think this information doesn't work for you, here are some things
to check.
Apache's config directory is `/etc/apache2/apache2.conf`. This is where
we get the `www-data` username from. It says:
# These need to be set in /etc/apache2/envvars
User ${APACHE_RUN_USER}
Group ${APACHE_RUN_GROUP}
Checking `/etc/apache2/envvars` we see the following:
export APACHE_RUN_USER=www-data
export APACHE_RUN_GROUP=www-data
So that's what we're using in the `chown` command in our instructions
above.
The default site is configured in
`/etc/apache2/sites-available/default`. In order for it to be *enabled*,
there must be a symlink from a file in `/etc/apache2/sites-enabled` to
the file in `sites-available`. You can enable it using the following
command:
sudo a2ensite default
This file also lists the directories we've used in our instructions
above.
ScriptAlias /cgi-bin/ /usr/lib/cgi-bin/
This means that `http://localhost/cgi-bin/wiki.pl` will call
`/usr/lib/cgi-bin/wiki.pl`
Don't forget to reload the Apache configuration as shown above, or
simply restart it all:
sudo service apache2 graceful
## Using just Perl
You can use Mojolicious as your web server. There is a simple
`server.pl` which you can use. Here's how you might start it:
mkdir ~/oddmuse
WikiDataDir=$HOME/oddmuse perl server.pl daemon
This makes the server available on `http://localhost:3000/wiki`. Make
sure you create the directory before starting the server! If you don't,
you'll get a strange error: \`STDERR: : No such file or directory at ...
perl5/Mojolicious/Plugin/CGI.pm\`.
If it works, feel free to upgrade to Hypnotoad.
WikiDataDir=$HOME/oddmuse hypnotoad server.pl
Note: Hypnotoad uses a different default port. The above makes the
server available on `http://localhost:8080/wiki`. Hypnotoad will keep
forking new processes. To stop it, use the `-s` flag.
hypnotoad -s server.pl
## License
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.1 or
any later version published by the Free Software Foundation.
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 2 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.
Both the GNU Free Documentation License, and the GNU General Public
License are distributed together with this script. See the files
[FDL](https://github.com/kensanata/oddmuse/blob/master/FDL) and
[GPL](https://github.com/kensanata/oddmuse/blob/master/GPL),
respectively.

View File

@@ -1,32 +1,51 @@
/* Authors: Murray Altheim (2004), Alex Schroeder (2004, 2005, 2006,
2009), Bayle Shanks (2006), Lion Kimbro (2006).
2009, 2020), Bayle Shanks (2006), Lion Kimbro (2006).
This file is in the public domain.
*/
html, body { /* hue 84 */
html {
/* background-color:#becc92; */
background-color:#def4b5;
text-align: center;
}
body { /* hue 84 */
/* Default color for text. It doesn't appear that many places,
but you'll see it in Recent Changes summary comments, and
you'll see it in the languages at the bottom of the place;
It seeps out, here and there. */
color:#000;
/* This is the main light green background color. */
background-color:#def4b5;
margin:0;
padding:0;
font-size: 14pt;
max-width: 80ex;
display: inline-block;
text-align: left;
}
/* This is not used in all that many places. */
body.gray {
background-color:#d5e0c5;
}
/* The next section includes some funky selectors.
See http://www.w3.org/TR/REC-CSS2/selector.html for more. */
div.content, div.rc, body > form, div.footnotes, div.edit text {
margin: 1em;
.wrapper {
padding: 1ex;
}
.languages {
display: none;
}
@media only screen and (max-width: 1200px) {
body {
padding: 5pt;
font-size: 15pt;
}
}
@media only screen and (max-width: 800px) {
body {
padding: 3pt;
font-size: 18pt;
}
}
/* The following statement hides the result count at the end
@@ -70,53 +89,16 @@ body.arrows a.near:before, body.arrows a.outside:before { content:"\2197"; }
body.arrows a.near, body.arrows a.outside { text-decoration:none; }
/* add every specific a here */
div.header h1 a:hover, h1 a:hover, h2 a:hover, h3 a:hover { color: #fbb; }
header h1 a:hover, h1 a:hover, h2 a:hover, h3 a:hover { color: #fbb; }
header h1 a:visited { color: #fff; }
a.definition:hover, a.near:hover, a:hover { color:#f00; }
dl.irc dt { width:20ex; float:left; text-align:right; clear:left; }
dl.irc dt span.time { float:left; }
dl.irc dd { margin-left:22ex; }
div.header {
background-color: #becc92;
margin: 0;
padding: 0;
height: 6em;
}
div.sidebar {
float: right;
width: 15%;
padding: 0 0.5em 0 1em;
margin: 1em 0 1em 5em;
font-size: x-small;
border: 3px solid #000;
text-align: left;
background-color: #dea;
}
div.sidebar h2 {
font-weight: bold;
font-size: small;
color: #000;
background-color: #dea;
padding: 0;
margin-right: 7%;
border-bottom: 1px solid #ab7;
}
div.sidebar ul, div.sidebar li {
display:block;
margin:0;
padding:0;
}
div.sidebar a:before {
content:"";
}
div.sidebar a {
font-weight: normal;
header {
margin: 0;
}
h3 {
@@ -128,52 +110,49 @@ h3 {
padding:0.3ex;
}
div.header span.gotobar {
header span.gotobar {
display:block;
padding:1ex;
}
div.message {
position: absolute;
top: 1.5em;
left:0;
right:0;
z-index: 5;
}
div.message p {
display:inline;
}
div.message, div.question {
background-color:#fee;
color:#f00;
border:solid #f00;
font-weight:bold;
padding:0.1em 0 0.1em 1em;
.message p, div.question {
font-size: smaller;
margin: 0;
padding: 0 0 0.5ex 1ex;
}
div.header h1 {
position: absolute;
top: 1.5em;
left:0;
right:0;
header h1 {
background-color:#517005;
font-family: "Tahoma", "Arial", "Helvetica", sans-serif;
font-size:xx-large;
border-bottom:2px dotted #87a036;
margin-top: 0;
padding: 0.125em 0.5em;
font-size: xx-large;
margin: 0;
padding: 0.1em 0.5ex;
}
div.header h1 a {
header h1 a {
text-decoration:none;
color: #ffffff;
}
img.logo {
position:absolute;
top:1ex;
right:1ex;
img.logo {
float: right;
height: 4em;
border:none;
z-index:10;
}
@media only screen and (max-width: 1200px) {
img.logo {
height: 3em;
}
}
@media only screen and (max-width: 800px) {
img.logo {
height: 2em;
}
}
.fit {
max-width: 100%;
}
.right {
@@ -182,6 +161,7 @@ img.logo {
.left {
float:left;
margin-right: 8px;
}
.top {
@@ -221,7 +201,7 @@ a.small img {
h1 {
font-weight:bold;
font-size:larger;
font-size:150%;
clear:left;
color:#fff;
background:#69aa00;
@@ -237,17 +217,23 @@ span.specialdays {
h2 {
font-weight:bold;
font-size:larger;
font-size:130%;
color:#fff;
background:#69aa00;
padding:0.7ex;
clear:left;
}
h2 a, div.journal h1 a {
/* Links in page titles */
h1 a, h2 a, div.journal h1 a {
text-decoration:none; color:#fff;
}
h3 {
font-weight:bold; font-size:medium; clear:left;
color:#fff; background:#84d600; padding:0.7ex;
font-weight:bold;
font-size: 110%;
clear:left;
color:#fff;
background:#84d600;
padding:0.7ex;
}
h3 a, div.journal h2 a {
text-decoration:none; color:#fff;
@@ -277,8 +263,8 @@ div.footnotes hr + p {
font-weight:bold;
}
div.footer {
background-color:#becc92;
footer {
background-color: #cd9;
border-bottom:solid;
clear: both;
margin: 3em 0 0 0;
@@ -287,13 +273,89 @@ div.footer {
color:black;
}
div.footer hr {
footer hr {
display:none;
}
/* License, definitions, near links */
.note, .more {
font-size: 80%;
}
.more {
margin: 1ex;
margin-bottom: 3em;
}
div.near, div.definition {
display: none;
}
#toggle_more:checked ~ div.near, #toggle_more:checked ~ div.definition {
display: block;
}
/* Recent Changes */
div.rc { margin-top:4ex; }
div.rc hr { display:none; }
div.rc {
overflow: hidden;
}
div.rc li + li {
margin-top: 1em;
}
div.rc li strong, table.history strong, strong.description {
font-family: inherit;
font-weight: inherit;
}
/* Colour flags for anonymous edits */
.red {
background: red;
color: red;
}
.orange {
background: orange;
color: orange;
}
.yellow {
background: yellow;
color: yellow;
}
.green {
background: green;
color: green;
}
.blue {
background: blue;
color: blue;
}
.indigo {
background: indigo;
color: indigo;
}
.violet {
background: violet;
color: violet;
}
.white {
background: white;
color: white;
}
.ip-code {
border: 1px solid #666;
}
/* Diff */
div.old { background-color:#ffd; }
div.new { background-color:#dfd; }
div.diff {
@@ -306,6 +368,9 @@ div.diff {
div.diff + hr {
display: none;
}
/* Referrers */
div.refer {
padding-left:5%;
padding-right:5%;
@@ -313,10 +378,9 @@ div.refer {
div.refer hr {
display: none;
}
div.rss { background-color:#ce9; }
body.gray div.rss {
background-color:#dec;
}
/* Sister Sites */
div.sister {
float:left;
margin-right:1ex;
@@ -326,7 +390,9 @@ div.sister p { padding:1ex; margin:0; }
div.sister hr { display:none; }
div.near, div.definition { padding:1ex; margin:0; }
div.near p, div.definition p { margin: 0; }
div.footer + hr { display:none; }
footer + hr { display:none; }
/* Headers in Journal Pages (e.g. Blog) */
div.journal hr { display:none; }
div.journal h1, div.journal h2, div.journal h3, div.journal h4 {
@@ -343,23 +409,65 @@ div.include {
span.description { font-weight:bold; }
span.new { display:inline; font-weight:bold; }
table.user { border-collapse:collapse; border:thin dotted; padding:1ex;
margin-bottom:1ex; width:inherit; margin:0 5%; }
table.user tr td { padding: 0.5ex 1em; border: thin dotted; text-align:left; }
/* Tables in wiki content */
table.user {
border-collapse:collapse;
border: none;
padding:1ex;
margin-bottom:1ex;
width:inherit;
margin:0 5%;
background-color: #efd;
}
/* table.user .even { */
/* background-color: #efd; */
/* } */
/* table.user .odd { */
/* background-color: #efe; */
/* } */
/* table.user .first { */
/* background-color: #eff; */
/* } */
table.user td, table.user th {
padding: 0.5ex 1em;
border: none;
text-align:left;
}
table.user th {
padding: 1ex 1em;
text-align: center;
}
/* Tables in page history */
table.history td[colspan="3"] {
padding: 1em 0;
}
/* Lists (definitions list being used by IRC logs?) */
dt { font-weight:bold; }
dd, li {
dd {
margin-bottom: 0.5ex;
margin-left: 2em;
}
li {
margin-bottom: 0.5ex;
margin-left: 0;
}
dl, ol, ul { margin-left:0em; }
textarea#text { width:75%; height:70%; }
textarea#summary { width:75%; height:10%; }
/* textarea, summary */
textarea {
box-sizing: border-box;
width:100%;
padding:5pt;
font-size: inherit;
}
textarea#text { height:70%; min-height: 20ex; }
textarea#summary { height:10%; min-height: 2ex; }
/* links to change from text to file and back */
@@ -375,12 +483,11 @@ form.edit a.svg, form.edit a.upload {
/* images */
img { border:0; }
pre, img.upload {
border: #777 1px solid; padding: 0.5em;
margin-left: 1em; margin-right: 2em;
pre, img.portrait, img.upload {
border: #777 1px solid; padding: 8px;
white-space: pre;
background-color: #fff; color: black;
overflow: hidden;
overflow: scroll;
}
a.smiley img.upload {
border:none;
@@ -388,32 +495,21 @@ a.smiley img.upload {
padding:0;
background-color:inherit;
}
.color { min-height: 60px; }
img.portrait {
float:left; clear:left;
background-color:#fff;
border:#999 1px solid;
padding:10px;
margin:10px;
}
div.portrait {
float:left; clear:left;
font-size:xx-small;
padding-left:10px;
}
div.portrait img.portrait {
float:none;
margin:10px 10px 0 0;
}
div.portrait a {
text-decoration:none;
color:#999;
}
div.color {
clear: left;
min-height:105px;
margin: 0;
padding: 0;
float: left;
margin-right: 8px;
}
div.portrait br { display: none }
div.portrait, div.portrait p { display: inline}
div.portrait p:after { content: ": " }
div.color > p:first-of-type { display: inline }
div.color { padding: 1ex 0.5ex 1em 0.5ex; }
.half img { max-width: 50%; }
/* indentation */
div.one {
background-color: #efb;
}
@@ -434,101 +530,6 @@ hr {
clear: left;
}
div.month {
float:left;
margin:3ex;
height:15ex;
}
div.month pre {
background-color:inherit;
border:none;
padding:0;
margin:0;
}
div.month a.edit {
font-weight:normal;
color:#000;
}
rss {
color:#000;
margin:0;
padding:0;
background-color:#def4b5;
}
docs {
position: absolute;
top:0;
left:0;
right:0;
font-size: xx-large;
height: 1.5em;
color: #becc92; /* invisible */
background-color: #becc92;
}
channel * {
display: block;
}
/* if IE can't parse this, no problem */
channel > title {
font-family: "Tahoma", "Arial", "Helvetica", sans-serif;
}
title {
background-color:#517005;
font-size:xx-large;
font-weight:bold;
margin-top: 1.5em;
padding: 0.125em 0.5em;
border-bottom:2px dotted #87a036;
color:#fff;
}
item title {
background-color:#69aa00;
font-size: medium;
margin: 0 0 0 1em;
padding:0.7ex 0.5em;
}
copyright {
font-size: smaller;
margin: 1em 4em;
}
channel > link:before {
font-size: x-large;
display: block;
margin: 1em;
padding: 0.5em;
content: "This is an RSS feed, designed to be read in a feed reader.";
color: red;
border: 1px solid red;
}
link, license {
font-size: smaller;
margin: 1em 2em;
}
username, description, generator, interwiki { margin: 1em; }
username:before { content: "Last edited by "; }
username:after { content: "."; }
generator:before { content: "Feed generated by "; }
generator:after { content: "."; }
channel description {
font-weight: bold;
}
item description {
font-style: italic;
font-weight: normal;
margin: 1em;
}
language,
pubDate, lastBuildDate, ttl, guid, category, comments,
image title, image link,
status, version, diff, history, importance {
display: none;
}
/*
== Printing ==
@@ -542,10 +543,10 @@ when the page is printed (or during print preview). More information:
@media print {
/* When printing, turn off a bunch of stuff. */
div.header span.gotobar,
header span.gotobar,
span.specialdays,
div.refer,
div.footer,
footer,
div.near,
div.definition,
div.sister,
@@ -592,19 +593,16 @@ span[lang=pt], .pt { background-color:#bfb; }
span[lang=es], .es { background-color:#fec; }
span[lang=sv], .sv { background-color:#adf; }
body.simple div.footer p.note,
body.simple div.footer span.gotobar + br,
body.simple div.footer span.gotobar,
body.simple footer p.note,
body.simple footer span.gotobar + br,
body.simple footer span.gotobar,
body.simple div.sister,
body.simple div.near,
body.simple div.definition,
body.simple div.languages { display:none; }
body.explicit a.near[title=MeatBall]:before { content:"MeatBall:"; }
body.explicit a.near[title=WikiFeatures]:before { content:"WikiFeatures:"; }
body.explicit a.near[title=CraoWiki]:before { content:"CraoWiki:"; }
body.explicit a.near[title=InterWiki]:before { content:"InterWiki:"; }
body.explicit a.near[title=OpenMeatballWiki]:before { content:"OpenMeatballWiki:"; }
body.explicit a.near[title=Wiki]:before { content:"Wiki:"; }
body.nolang span[lang] { background-color:inherit; }

425
css/latex.css Normal file
View File

@@ -0,0 +1,425 @@
/*!
* 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-2016 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2013-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
@@ -96,16 +96,20 @@ sub DoBanHosts {
if (IsItBanned($_, \@regexps)) {
print $q->p(Ts("%s is banned", $name));
} else {
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();
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();
}
}
}
}
@@ -167,47 +171,73 @@ 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}';
my ($start, $end) = $response->{inetnum} =~ /($re) *- *($re)/;
return $start, $end;
# 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;
}
sub get_groups {
my ($from, $to) = @_;
my @groups;
if ($from < 10) {
my $to = $to >= 10 ? 9 : $to;
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) {
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;
}
@@ -235,24 +265,42 @@ 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];
} elsif ($start[$i] eq '0' and $end[$i] eq '255') {
$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\.
last;
} 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 .= '\.';
} 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;
last;
} else {
$regexp .= '(' . get_regexp_range($start[$i], $end[$i]) . ')$';
warn "Unhandled regexp: $from - $to ($i)";
$regexp .= 'XXX';
$regexp .= '\.' if $i < 3;
last;
}
$regexp .= '\.' if $i < 3;
}
return $regexp;
}
# this is required in case we concatenate other modules to this one
package OddMuse;

View File

@@ -64,13 +64,11 @@ 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) 2004, 2005, 2006 Alex Schroeder <alex@emacswiki.org>
# Copyright (C) 20042023 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2006 Ingo Belka
#
# This program is free software; you can redistribute it and/or modify
@@ -112,9 +112,7 @@ 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 = (grep(/$match/, $search
? SearchTitleAndBody($search)
: AllPagesList()));
my @pages = Matched($match, $search ? SearchTitleAndBody($search) : AllPagesList());
if (!$CollectingJournal) {
$CollectingJournal = 1;
# Now save information required for saving the cache of the current page.

66
modules/cook-lang.pl Normal file
View File

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

View File

@@ -217,7 +217,7 @@ sub PrintPageContentCrossbar {
# If the crossbar div is placed immediately after the content div, place it
# immediately before the content div.
if (not ($html =~ s~(<div class="content browse">)$crossbar_pattern~$2$1~)) {
if (not ($html =~ s~(<div class="content browse" lang="[a-z]*">)$crossbar_pattern~$2$1~)) {
# Otherwise, if the crossbar div is placed immediately before the end of the
# content div, place it immediately after the end of the content div.
$html =~

View File

@@ -0,0 +1,37 @@
#! /usr/bin/perl
# 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 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('definition-lists.pl', 'Definition Lists Extension');
our ($q, $bol, @MyRules, @HtmlStack, $Fragment);
push(@MyRules, \&DefinitionListsRule);
# term
# : definition
sub DefinitionListsRule {
if ($bol and /\G(?:\s*\n)*(\S.*)\n[ \t]*:[ \t]*/cg) {
return OpenHtmlEnvironment('dl', 1) . "<dt>$1</dt>" . AddHtmlEnvironment('dd');
} elsif (InElement('dd') and /\G(?:\s*\n)+(\S.*)\n[ \t]*:[ \t]*/cg) {
return OpenHtmlEnvironment('dl', 1) . "<dt>$1</dt>" . AddHtmlEnvironment('dd');
} elsif (InElement('dd') and /\G(\s*\n)+[ \t]*:[ \t]*/cg) {
return OpenHtmlEnvironment('dl', 1) . AddHtmlEnvironment('dd');
}
return;
}

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

View File

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

View File

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

48
modules/grep-filtered.pl Normal file
View File

@@ -0,0 +1,48 @@
# Copyright (C) 2020 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2020 Daniel MacKay <daniel@bonmot.ca>
#
# 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('grep-filtered.pl', 'Grep Filtered');
our ($PageDir);
our ($UseGrep);
$UseGrep = 1;
*OldGrepFiltered = \&Filtered;
*Filtered = \&NewGrepFiltered;
sub NewGrepFiltered {
my ($string, @pages) = @_;
my @pages = OldGrepFiltered(@_);
my $regexp = SearchRegexp($string);
return @pages unless GetParam('grep', $UseGrep) and $regexp;
my @result = grep(/$regexp/i, @pages); # search parameter for page titles
my %found = map {$_ => 1} @result;
$regexp =~ s/\\n(\)*)$/\$$1/g; # sometimes \n can be replaced with $
$regexp =~ s/([?+{|()])/\\$1/g; # basic regular expressions from man grep
# if we know of any remaining grep incompatibilities we should
# return @pages here!
$regexp = quotemeta($regexp);
open(F, '-|:encoding(UTF-8)', "find $PageDir -type f -print0 | xargs -0 -n10 -P4 grep --ignore-case -l '$regexp'") ;
while (<F>) {
my ($pageName) = m/.*\/(.*)\.pg$/ ;
push(@result, $pageName) if not $found{$pageName};
} close(F);
return sort @result;
}

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'});
$result = $q->img({-src=>$src, -alt=>$alt, -title=>$alt, -class=>'upload', -loading=>'lazy'});
$result = $q->a({-href=>$link, -class=>$linkclass}, $result);
if ($comments) {
for (split '\n', $comments) {

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2004, 2007 Alex Schroeder <alex@emacswiki.org>
# Copyright (C) 20042023 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
@@ -47,8 +47,5 @@ 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);
my $match = GetParam('match', '');
@pages = grep /$match/i, @pages if $match;
@pages = sort @pages;
return @pages;
return sort Matched(GetParam('match'), @pages);
}

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20042018 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20042023 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,7 +18,8 @@ use v5.10;
AddModuleDescription('journal-rss.pl', 'Journal RSS Extension');
our ($OpenPageName, $CollectingJournal, %Page, %Action, @MyInitVariables, $DeletedPage, %NearLinksException);
our ($OpenPageName, $CollectingJournal, %Page, %Action, @MyInitVariables, $DeletedPage, %NearLinksException,
$RecentLink, $SiteName, $SiteDescription, $ScriptName, $RssRights);
$Action{journal} = \&DoJournalRss;
# Currently RSS works like RecentChanges, which is not what bloggers
@@ -30,22 +31,40 @@ 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);
print GetHttpHeader('application/xml') . GetRcRss();
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();
}
}
sub JournalRssParameters {
my $more = '';
foreach (@_, qw(rsslimit match search reverse monthly)) {
my $val = GetParam($_, '');
$more .= ";$_=$val" if $val;
$more .= ";$_=" . UrlEncode($val) if $val;
}
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));
}
@@ -67,7 +86,7 @@ sub JournalRssGetRcLines {
my $reverse = GetParam('reverse', 0);
my $monthly = GetParam('monthly', 0);
my $offset = GetParam('offset', 0);
my @pages = sort JournalSort (grep(/$match/, $search ? SearchTitleAndBody($search) : AllPagesList()));
my @pages = sort JournalSort (Matched($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) 20092015 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20092022 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
@@ -230,6 +230,10 @@ sub MailMenu {
ScriptLink('action=subscriptionlist',
T('All mail subscriptions'),
'subscriptionlist')) if UserIsAdmin();
push(@$menuref,
ScriptLink('action=subscribers',
T('All mail subscribers'),
'subscribers')) if UserIsAdmin();
}
=head1 Your subscriptions
@@ -283,9 +287,9 @@ sub MailSubscription {
=head1 Administrator Access
The subscriptionlist action will show you the subscription database,
if you're an administrator. It's a plain text file of the data, which
you can use for debugging and scripting purposes.
The C<subscriptionlist> action will show you the subscription database, if
you're an administrator. With the C<raw> parameter set it's a plain text file of
the data, which you can use for debugging and scripting purposes.
=cut
@@ -327,6 +331,41 @@ sub MailLink {
. join(';', map { "pages=$_" } @pages), $str);
}
=pod
The C<subscribers> action lists each unique email address for easier mass
unsubscribing of email addresses after a wave of wiki spam.
=cut
$Action{subscribers} = \&DoMailSubscribers;
sub DoMailSubscribers {
UserIsAdminOrError();
my $raw = GetParam('raw', 0);
if ($raw) {
print GetHttpHeader('text/plain');
} else {
print GetHeader('', T('Subscriptions')),
$q->start_div({-class=>'content subscribtionlist'}),
$q->p(T('Mail addresses are linked to unsubscription links.')),
'<ul>';
}
my %authors;
require DB_File;
tie my %h, "DB_File", encode_utf8($MailFile);
for my $author (sort grep /\@/, map { UrlDecode($_) } keys %h) {
if ($raw) {
print "$author\n";
} else {
print $q->li(ScriptLink("action=unsubscribe;who=$author", $author));
}
}
print '</ul></div>' unless $raw;
PrintFooter() unless $raw;
untie %h;
}
=head1 Subscription
The subscribe action will subscribe you to pages. The mail parameter
@@ -402,13 +441,13 @@ sub MailSubscribe {
=head1 Unsubscription
The unsubscribe action will unsubscribe you from pages. The mail
parameter contains the mail address to use and defaults to the value
store in your cookie. Multiple pages parameters contain the pages to
unsubscribe.
The unsubscribe action will unsubscribe you from pages. The mail parameter
contains the mail address to use and defaults to the value store in your cookie.
Multiple pages parameters contain the pages to unsubscribe. Without naming
pages, you will be unsubscribed from all pages.
The who parameter overrides the mail parameter and is used for
administrator unsubscription from the subscriptionlist action.
The who parameter overrides the mail parameter and is used for administrator
unsubscription from the subscriptionlist action.
=cut
@@ -423,9 +462,13 @@ sub DoMailUnsubscribe {
# MailUnsubscribe will set a parameter and must run before printing
# the header.
print GetHeader('', T('Subscriptions')),
$q->start_div({-class=>'content unsubscribe'});
print $q->p(Ts('Unsubscribed %s from the following pages:', $mail));
print $q->ul($q->li([map { GetPageLink($_) } @pages]));
$q->start_div({-class=>'content unsubscribe'});
if (@pages) {
print $q->p(Ts('Unsubscribed %s from the following pages:', $mail));
print $q->ul($q->li([map { GetPageLink($_) } @pages]));
} else {
print $q->p(Ts('Unsubscribed %s from all pages.', $mail));
}
print $q->p(ScriptLink('action=subscriptions', T('Your mail subscriptions'),
'subscriptions') . '.');
print $q->end_div();
@@ -434,10 +477,11 @@ sub DoMailUnsubscribe {
sub MailUnsubscribe {
my ($mail, @pages) = @_;
return unless $mail and @pages;
return unless $mail;
require DB_File;
tie my %h, "DB_File", encode_utf8($MailFile);
my %subscriptions = map {$_=>1} split(/$FS/, UrlDecode($h{UrlEncode($mail)}));
@pages = keys %subscriptions unless @pages;
foreach my $id (@pages) {
delete $subscriptions{$id};
# take care of reverse lookup
@@ -461,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
because 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 the keys and values of
the DB_File are URL encoded.
=cut

View File

@@ -1,5 +1,5 @@
#! /usr/bin/perl
# Copyright (C) 20142017 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20142022 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
@@ -18,7 +18,7 @@ use v5.10;
AddModuleDescription('markdown-rule.pl', 'Markdown Rule Extension');
our ($q, $bol, %RuleOrder, @MyRules, $UrlProtocols, $FullUrlPattern, @HtmlStack);
our ($q, $bol, %RuleOrder, @MyRules, $UrlProtocols, $FullUrlPattern, @HtmlStack, $Fragment);
push(@MyRules, \&MarkdownRule);
# Since we want this package to be a simple add-on, we try and avoid
@@ -31,6 +31,7 @@ $RuleOrder{\&MarkdownRule} = 200;
# https://help.github.com/articles/github-flavored-markdown
sub MarkdownRule {
my $alignment;
# \escape
if (m/\G\\([-#>*`=])/cg) {
return $1;
@@ -50,9 +51,28 @@ sub MarkdownRule {
}
# > blockquote
# with continuation
elsif ($bol and m/\G&gt;/cg) {
return CloseHtmlEnvironments()
. AddHtmlEnvironment('blockquote');
elsif ($bol and m/\G((?:&gt;.*\n?)+)/cg) {
Clean(CloseHtmlEnvironments());
Dirty($1);
my $text = $1;
my ($oldpos, $old_) = ((pos), $_);
print '<blockquote>';
$text =~ s/^&gt; ?//gm;
ApplyRules($text, 1, 1, undef, 'p'); # local links, anchors, no revision, start with p
print '</blockquote>';
Clean(AddHtmlEnvironment('p')); # if dirty block is looked at later, this will disappear
($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
}
# """ = blockquote, too
elsif ($bol and m/\G("""[ \t]*\n(.*?)\n"""[ \t]*(?:\n|$))/cgs) {
Clean(CloseHtmlEnvironments());
Dirty($1);
my ($oldpos, $old_) = ((pos), $_);
print '<blockquote>';
ApplyRules($2, 1, 1, undef, 'p'); # local links, anchors, no revision, start with p
print '</blockquote>';
Clean(AddHtmlEnvironment('p')); # if dirty block is looked at later, this will disappear
($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
}
# ``` = code
elsif ($bol and m/\G```[ \t]*\n(.*?)\n```[ \t]*(\n|$)/cgs) {
@@ -123,34 +143,47 @@ sub MarkdownRule {
# beginning of a table
elsif ($bol and !InElement('table') and m/\G\|/cg) {
# warn pos . " beginning of a table";
$alignment = 'style="text-align: right"' if m/\G([ \t]+)/cg;
$alignment = 'style="text-align: center"' if $alignment and m/\G(?=[^|]+[ \t]+\|)/cg;
$Fragment =~ s/[ \t]+$//; # cleanup trailing whitespace if previous column was centered
return OpenHtmlEnvironment('table',1)
. AddHtmlEnvironment('tr')
. AddHtmlEnvironment('th');
. AddHtmlEnvironment('th', $alignment);
}
# end of a row and beginning of a new row
elsif (InElement('table') and m/\G\|?\n\|/cg) {
# warn pos . " end of a row and beginning of a new row";
$alignment = 'style="text-align: right"' if m/\G([ \t]+)/cg;
$alignment = 'style="text-align: center"' if $alignment and m/\G(?=[^|]+[ \t]+\|)/cg;
$Fragment =~ s/[ \t]+$//; # cleanup trailing whitespace if previous column was centered
return CloseHtmlEnvironment('tr')
. AddHtmlEnvironment('tr')
. AddHtmlEnvironment('td');
. AddHtmlEnvironment('td', $alignment);
}
# otherwise the table ends
elsif (InElement('table') and m/\G\|?(\n|$)/cg) {
# warn pos . " otherwise the table ends";
$Fragment =~ s/[ \t]+$//; # cleanup trailing whitespace if previous column was centered
return CloseHtmlEnvironment('table')
. AddHtmlEnvironment('p');
}
# continuation of the first row
elsif (InElement('th') and m/\G\|/cg) {
# warn pos . " continuation of the first row";
$alignment = 'style="text-align: right"' if m/\G([ \t]+)/cg;
$alignment = 'style="text-align: center"' if $alignment and m/\G(?=[^|]+[ \t]+\|)/cg;
$Fragment =~ s/[ \t]+$//; # cleanup trailing whitespace if previous column was centered
return CloseHtmlEnvironment('th')
. AddHtmlEnvironment('th');
. AddHtmlEnvironment('th', $alignment);
}
# continuation of other rows
elsif (InElement('td') and m/\G\|/cg) {
# warn pos . " continuation of other rows";
$alignment = 'style="text-align: right"' if m/\G([ \t]+)/cg;
$alignment = 'style="text-align: center"' if $alignment and m/\G(?=[^|]+[ \t]+\|)/cg;
$Fragment =~ s/[ \t]+$//; # cleanup trailing whitespace if previous column was centered
return CloseHtmlEnvironment('td')
. AddHtmlEnvironment('td');
. AddHtmlEnvironment('td', $alignment);
}
# whitespace indentation = code
elsif ($bol and m/\G(\s*\n)*( .+)\n?/cg) {
@@ -160,13 +193,21 @@ sub MarkdownRule {
}
return OpenHtmlEnvironment('pre',1) . $str; # always level 1
}
# [an example](http://example.com/ "Title")
elsif (m/\G\[(.+?)\]\($FullUrlPattern(\s+"(.+?)")?\)/cg) {
# link: [an example](http://example.com/ "Title")
elsif (m/\G\[((?:[^]\n]+\n?)+)\]\((\S+)(\s+"(.+?)")?\)/cg) {
my ($text, $url, $title) = ($1, $2, $4);
$url =~ /^($UrlProtocols)/;
my %params;
$params{-href} = $url;
$params{-class} = "url $1";
$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{-title} = $title if $title;
return $q->a(\%params, $text);
}

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2012 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20042022 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,10 +42,18 @@ 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, $RcFile, $RcOldFile, $RcDefault, $PageDir, $KeepDir, $LockDir, $TempDir, $IndexFile, $VisitorFile, $NoEditFile, $WikiDescription, $LastUpdate, $StaticDir, $StaticUrl, $InterWikiMoniker, $RefererDir, $PermanentAnchorsFile);
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 ($NamespacesMain, $NamespacesSelf, $NamespaceCurrent,
$NamespaceRoot, $NamespaceSlashing, @NamespaceParameters,
%Namespaces);
$NamespaceRoot, $NamespaceSlashing, @NamespaceParameters,
%Namespaces, $NamespacesRootDataDir);
$NamespacesMain = 'Main'; # to get back to the main namespace
$NamespacesSelf = 'Self'; # for your own namespace
@@ -110,6 +118,7 @@ sub NamespacesInitVariables {
}
}
$NamespaceRoot = $ScriptName; # $ScriptName may be changed below
$NamespacesRootDataDir = $DataDir; # $DataDir may be chanegd below
$NamespaceCurrent = '';
my $ns = GetNamespace();
if ($ns
@@ -117,7 +126,7 @@ sub NamespacesInitVariables {
and $ns ne $NamespacesSelf) {
$NamespaceCurrent = $ns;
# Change some stuff from the original InitVariables call:
$SiteName .= ' ' . $NamespaceCurrent;
$SiteName .= ' ' . NormalToFree($NamespaceCurrent);
$InterWikiMoniker = $NamespaceCurrent;
$DataDir .= '/' . $NamespaceCurrent;
$PageDir = "$DataDir/page";
@@ -162,6 +171,56 @@ 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

198
modules/network-blocker.pl Normal file
View File

@@ -0,0 +1,198 @@
# -*- 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

@@ -22,21 +22,18 @@ our ($q, @MyAdminCode);
*OldGetSearchLink = \&GetSearchLink;
*GetSearchLink = \&NewGetSearchLink;
sub NewGetSearchLink {
my ($text, $class, $name, $title) = @_;
$name = UrlEncode($name);
$text =~ s/_/ /g;
return $q->span({-class=>$class}, $text);
my ($id, $class, $name, $title) = @_;
return NormalToFree($id);
}
push(@MyAdminCode, \&BacklinksMenu);
sub BacklinksMenu {
my ($id, $menuref, $restref) = @_;
if ($id) {
my $text = T('Backlinks');
my $class = 'backlinks';
my $name = 'backlinks';
my $title = T('Click to search for references to this page');
my $link = ScriptLink('search=' . $id, $text, $class, $name, $title);
push(@$menuref, $link);
my $form = GetFormStart(undef, 'post', 'search');
$form .= $q->input({-type=>'hidden', -name=>'search', -value=>'"'.NormalToFree($id).'"'});
$form .= $q->p(T('Click to search for references to this page'));
$form .= $q->submit('search', T('Go!')) . $q->end_form;
push(@$menuref, $form);
}
}

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

View File

@@ -0,0 +1,166 @@
#! /usr/bin/perl
# Copyright (C) 2025 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;
use utf8;
AddModuleDescription('post-instead-of-get.pl', 'POST instead of GET extension');
our ($q, $Now, $LastUpdate, %Action, @RcDays, $RcDefault, $ShowRollbacks, $ShowAll,
$ShowEdits, %Languages, $FullUrl);
# You should install nosearch.pl, too.
# Change the search from GET to POST
*PostOldGetSearchForm=*GetSearchForm;
*GetSearchForm=*PostNewGetSearchForm;
sub PostNewGetSearchForm {
my $html = PostOldGetSearchForm(@_);
$html =~ s/method="get"/method="post"/;
return $html;
}
# Change the index filter from GET to POST
*PostOldDoIndex=*DoIndex;
*DoIndex=*PostNewDoIndex;
# Update action hash as well!
$Action{index} = \&DoIndex;
sub PostNewDoIndex {
# Must capture the output.
my $html = ToString(\&PostOldDoIndex);
$html =~ s/method="get"/method="post"/;
print $html;
}
# Disable links in the Recent Changes menu
*PostOldRcHeader=*RcHeader;
*RcHeader=*PostNewRcHeader;
sub PostNewRcHeader {
my ($from, $upto, $html) = (GetParam('from', 0), GetParam('upto', 0), '');
my $days = GetParam('days') + 0 || $RcDefault; # force numeric $days
my $all = GetParam('all', $ShowAll);
if ($from) {
$html .= $q->h2(Ts('Updates since %s', TimeToText(GetParam('from', 0))) . ' '
. ($upto ? Ts('up to %s', TimeToText($upto)) : ''));
} else {
$html .= $q->h2((GetParam('days', $RcDefault) != 1)
? Ts('Updates in the last %s days', $days)
: Ts('Updates in the last day'));
}
$html .= $q->p({-class => 'documentation'}, T('Using the 「rollback」 button on this page will reset the wiki to that particular point in time, undoing any later changes to all of the pages.')) if UserIsAdmin() and $all;
return $html;
}
# Change the More... link
*PostOldRcHtml=*RcHtml;
*RcHtml=*PostNewRcHtml;
sub PostNewRcHtml {
my $html = PostOldRcHtml(@_);
# Based on RcPreviousAction
my $form = GetFormStart(undef, 'post', 'more');
my $interval = GetParam('days', $RcDefault) * 86400;
# use delta between from and upto, or use days, whichever is available
my $to = GetParam('from', GetParam('upto', $Now - $interval));
my $from = $to - (GetParam('upto') ? GetParam('upto') - GetParam('from') : $interval);
$form .= $q->input({-type=>'hidden', -name=>'action', -value=>'rc'});
$form .= $q->input({-type=>'hidden', -name=>'from', -value=>$from});
$form .= $q->input({-type=>'hidden', -name=>'upto', -value=>$to});
# Based on RcOtherParameters
foreach (qw(days page diff full all showedit rollback rcidonly rcuseronly rchostonly rcclusteronly rcfilteronly match lang followup)) {
my $val = GetParam($_, '');
$form .= $q->input({-type=>'hidden', -name=>$_, -value=>$val}) if $val;
}
$form .= $q->submit('more', T('More...'));
$form .= $q->end_form();
$html =~ s/<p class="more">.*?<\/p>//;
return $html . $form;
}
# Change Recent Changes filter form to represent all options.
*PostOldGetFilterForm=*GetFilterForm;
*GetFilterForm=*PostNewGetFilterForm;
sub PostNewGetFilterForm {
my $all = GetParam('all', $ShowAll);
my $showedit = GetParam('showedit', $ShowEdits);
my $rollback = GetParam('rollback', $ShowRollbacks);
my $lang = GetParam('lang', '');
my $form = GetFormStart(undef, 'post', 'filter') . $q->h2(T('Filters'));
$form .= $q->input({-type=>'hidden', -name=>'action', -value=>'rc'});
$form .= $q->radio_group(-name=>'days', -values=>\@RcDays, -default=> $RcDefault) . ' ' . T('days') . $q->br();
$form .= $q->input({-type=>'checkbox', -id=>'all', -name=>'all', -value=>1, $all && '-checked'});
$form .= $q->label({-for=>'all'}, ' ' . T('List all changes')) . $q->br();
$form .= $q->input({-type=>'checkbox', -id=>'showedit', -name=>'showedit', -value=>1, $showedit && '-checked'});
$form .= $q->label({-for=>'showedit'}, ' ' . T('Include minor changes')) . $q->br();
$form .= $q->input({-type=>'checkbox', -id=>'rollback', -name=>'rollback', -value=>1, $rollback && '-checked'});
$form .= $q->label({-for=>'rollback'}, ' ' . T('Include rollbacks')) . $q->br();
foreach my $h (['match' => T('Title:')], ['rcfilteronly' => T('Title and Body:')],
['rcuseronly' => T('Username:')], ['rchostonly' => T('Host:')], ['followup' => T('Follow up to:')]) {
$form .= $q->label({-for=>$h->[0], -style=>'width:20ch; display:inline-block'}, $h->[1]);
$form .= $q->textfield(-name=>$h->[0], -id=>$h->[0], -size=>20);
$form .= $q->br();
}
if (%Languages) {
$form .= $q->label({-for=>'rclang', -style=>'width:20ch; display:inline-block'}, T('Language:'));
$form .= $q->textfield(-name=>'lang', -id=>'rclang', -size=>20, -default=>$lang);
}
$form .= $q->br() . $q->submit('dofilter', T('Go!')) . $q->end_form;
$form .= GetFormStart(undef, 'post', 'later');
$form .= $q->input({-type=>'hidden', -name=>'action', -value=>'rc'});
$form .= $q->input({-type=>'hidden', -name=>'all', -value=>1}) if $all;
$form .= $q->input({-type=>'hidden', -name=>'showedit', -value=>1}) if $showedit;
$form .= $q->input({-type=>'hidden', -name=>'from', -value=>$LastUpdate+1});
$form .= $q->p(T('List later changes') . ' ' . $q->submit('dofilter', T('Go!')));
$form .= $q->end_form;
$form .= $q->p({-class => 'documentation'}, T('Using the 「rollback」 button on this page will reset the wiki to that particular point in time, undoing any later changes to all of the pages.')) if UserIsAdmin() and $all;
return $form;
}
# History page with new form
*PostOldGetFooterLinks=*GetFooterLinks;
*GetFooterLinks=*PostNewGetFooterLinks;
sub PostNewGetFooterLinks {
my $html = PostOldGetFooterLinks(@_);
my ($id, $rev) = @_;
if ($Action{history} and $rev ne '') {
my $label = T('View all changes');
my $unwanted = quotemeta(GetRCLink($id, $label));
my $form = qq{
<form style="display: inline" method="POST" action="$FullUrl">
<input type="hidden" name="action" value="rc"/>
<input type="hidden" name="all" value="1"/>
<input type="hidden" name="showedit" value="1"/>
<input type="hidden" name="from" value="1"/>
<input type="hidden" name="rcidonly" value="$id"/>
<input type="submit" name="dobacklinks" value="$label">
</form>};
$html =~ s/$unwanted/$form/;
}
return $html;
}
1;

View File

@@ -171,7 +171,7 @@ sub ReCaptchaGetQuestion {
# if (defined $ReCaptchaTabIndex) { $recaptcha_options{tabindex} = $ReCaptchaTabIndex; }
eval "use Captcha::reCAPTCHA";
my $captcha_html = Captcha::reCAPTCHA->new()->get_html(
my $captcha_html = Captcha::reCAPTCHA->new()->get_html_v2(
$ReCaptchaPublicKey, undef, $ENV{'HTTPS'} eq 'on', undef);
my $submit_html = $need_button ? $q->submit(-value=> T('Go!')) : '';
my $options_html = '
@@ -239,11 +239,12 @@ sub NewReCaptchaDoPost {
sub ReCaptchaCheckAnswer {
eval "use Captcha::reCAPTCHA";
my $result = Captcha::reCAPTCHA->new()->check_answer(
my $answer = GetParam('g-recaptcha-response');
return 0 unless $answer;
my $result = Captcha::reCAPTCHA->new()->check_answer_v2(
$ReCaptchaPrivateKey,
$q->remote_addr(),
GetParam('recaptcha_challenge_field'),
GetParam('recaptcha_response_field')
$answer,
$q->remote_addr()
);
return $result->{is_valid};
}

View File

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

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2006, 2007, 2008 Alex Schroeder <alex@emacswiki.org>
# 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
@@ -36,18 +36,12 @@ sub SearchListRule {
$term = GetId();
}
local ($OpenPageName, %Page);
my %hash = ();
my @found;
if ($variation eq 'list') {
foreach my $id (SearchTitleAndBody($term)) {
$hash{$id} = 1 unless $id eq $original; # skip the page with the query
}
@found = grep { $_ ne $original } SearchTitleAndBody($term);
} elsif ($variation eq 'titlelist') {
@found = grep { $_ ne $original } Matched($term, AllPagesList());
}
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 {
@@ -63,32 +57,24 @@ 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 %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;
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;
PrintFooter();
}

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20072014 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20072023 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,8 +36,7 @@ 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);
my $match = GetParam('match', '');
@pages = grep /$match/i, @pages if $match;
@pages = Matched(GetParam('match', ''), @pages);
@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'});
my $result = $q->img({-src=>StaticFileName($id), -alt=>$alt, -class=>'upload', -loading=>'lazy'});
$result = ScriptLink($id, $result, 'image');
return $result;
} else {
@@ -198,7 +198,7 @@ EOT
my $logo = $LogoUrl;
$logo =~ s|.*/||; # just the filename
my $alt = T('[Home]');
$header .= $q->img({-src=>$logo, -alt=>$alt, -class=>'logo'}) if $logo;
$header .= $q->img({-src=>$logo, -alt=>$alt, -class=>'logo', -loading=>'lazy'}) if $logo;
}
# top toolbar
local $UserGotoBar = ''; # only allow @UserGotoBarPages
@@ -317,7 +317,7 @@ sub GetDownloadLink {
$action = $ScriptName . '?' . $action;
}
return $action if $image == 2;
my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload'});
my $result = $q->img({-src=>$action, -alt=>$alt, -class=>'upload', -loading=>'lazy'});
$result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
return $result;
} else {

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

View File

@@ -62,16 +62,26 @@ Example:
$TagFeedIcon = 'http://www.example.org/pics/rss.png';
=head2 $TagCloudSize
The number of most used tags when looking at the tag cloud. The
default is 50.
Example:
$TagCloudSize = 20;
=cut
our ($q, $Now, %Action, %Page, $FreeLinkPattern, @MyInitVariables, @MyRules, @MyAdminCode, $DataDir, $ScriptName);
our ($TagUrl, $TagFeed, $TagFeedIcon, $TagFile);
our ($TagUrl, $TagFeed, $TagFeedIcon, $TagFile, $TagCloudSize);
push(@MyInitVariables, \&TagsInit);
sub TagsInit {
$TagUrl = ScriptUrl('action=rc;rcfilteronly=tag:%s') unless $TagUrl;
$TagFeed = ScriptUrl('action=rss;rcfilteronly=tag:%s') unless $TagFeed;
$TagCloudSize = 50 unless $TagCloudSize;
$TagFile = "$DataDir/tag.db";
}
@@ -113,7 +123,8 @@ sub TagsRule {
-title=>T('Feed for this tag'),
-rel=>'feed'
}, $q->img({-src=>$TagFeedIcon,
-alt=>T('RSS')}));
-alt=>T('RSS'),
-loading=>'lazy'}));
}
return $html;
}
@@ -305,27 +316,16 @@ $Action{tagcloud} = \&TagCloud;
sub TagCloud {
print GetHeader('', T('Tag Cloud'), ''),
$q->start_div({-class=>'content cloud'}) . '<p>';
$q->start_div({-class=>'content cloud'});
require HTML::TagCloud;
my $cloud = HTML::TagCloud->new;
# open the DB file
my %h = TagReadHash();
my $max = 0;
my $min = 0;
my %count = ();
foreach my $tag (grep !/^_/, keys %h) {
$count{$tag} = @{$h{$tag}};
$max = $count{$tag} if $count{$tag} > $max;
$min = $count{$tag} if not $min or $count{$tag} < $min;
$cloud->add(NormalToFree($tag), "$ScriptName?search=tag:" . UrlEncode($tag), scalar @{$h{$tag}});
}
foreach my $tag (sort keys %count) {
my $n = $count{$tag};
print $q->a({-href => "$ScriptName?search=tag:" . UrlEncode($tag),
-title => $n,
-style => 'font-size: '
. int(80+120*($max == $min ? 1 : ($n-$min)/($max-$min)))
. '%;',
}, NormalToFree($tag)), ' ... ';
}
print '</p></div>';
print $cloud->html_and_css($TagCloudSize);
print '</div>';
PrintFooter();
}
@@ -425,13 +425,12 @@ sub TagsMenu {
my ($id, $menuref, $restref) = @_;
push(@$menuref,
ScriptLink('action=reindex', T('Rebuild tag index'), 'reindex')
. ', ' . ScriptLink('action=taglist', T('list tags'), 'taglist')
. ', ' . ScriptLink('action=tagcloud', T('tag cloud'), 'tagcloud'));
}
=head1 COPYRIGHT AND LICENSE
Copyright (C) 20052015 Alex Schroeder <alex@gnu.org>
Copyright (C) 20052019 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

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à
jusquà %s
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 n'existe pas
La page %s nexiste 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:
Email:
Courriel :
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 d'indiquer quelle langue vous allez utiliser.
Merci dindiquer 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 s'il vous plaît un nom de page pour la traduction de %s.
Indiquez sil 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

@@ -296,6 +296,8 @@ Delete
Filter:
Summary:
Last edit
revision %s
@@ -310,8 +312,6 @@ later minor edits
No diff available.
Summary:
Old revision:
Changed:
@@ -1201,6 +1201,8 @@ Your mail subscriptions
All mail subscriptions
All mail subscribers
Subscriptions
Email:
@@ -1227,6 +1229,8 @@ 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.
@@ -1409,6 +1413,11 @@ Click to search for references to this permanent anchor
Include permanent anchors
################################################################################
# modules/pingback-server.pl
################################################################################
Only XML-RPC POST requests recognised
################################################################################
# modules/portrait-support.pl
################################################################################
@@ -1473,6 +1482,17 @@ Referrers
################################################################################
All Referrers
################################################################################
# modules/rename-pages.pl
################################################################################
Target page already exists.
Source page does not exist.
Copied from %s
Moved to %s
################################################################################
# modules/search-list.pl
################################################################################
@@ -1539,8 +1559,6 @@ Rebuilding index not done.
Rebuild tag index
list tags
tag cloud
################################################################################
@@ -1649,15 +1667,7 @@ Upgrade complete. Please remove $ModuleDir/upgade.pl, now.
################################################################################
# modules/usemod.pl
################################################################################
http://search.barnesandnoble.com/booksearch/isbninquiry.asp?ISBN=%s
http://www.amazon.com/exec/obidos/ISBN=%s
alternate
http://www.pricescan.com/books/BookDetail.asp?isbn=%s
search
https://en.wikipedia.org/wiki/Special:BookSources/%s
################################################################################
# modules/wanted.pl
@@ -1697,5 +1707,56 @@ Edit %s.
################################################################################
Tags:
################################################################################
# modules/webmention.pl
################################################################################
Webmention module requires $CommentsPrefix to be set
Webmention requires a POST request
Webmention requires x-www-form-urlencoded requests
Webmention must mention a specific page
Webmention must mention a valid page
Your IP number is blocked: %s
Webmention must mention an existing page
Webmention must mention source
Webmention must mention target
The URL is blocked: %s
Webmention source cannot be verified: %1 returns %2 %3
Webmention source does not link to %s
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,6 +5,7 @@
# 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,
@@ -300,6 +301,8 @@ Delete
Filter:
Summary:
Sammanfattning:
Last edit
revision %s
@@ -314,8 +317,6 @@ later minor edits
No diff available.
Information om ändring är inte tillgänglig.
Summary:
Sammanfattning:
Old revision:
Gammal version:
Changed:
@@ -699,11 +700,6 @@ Clustermap
Klusterkarta
Pages without a Cluster
Sidor utan kluster
################################################################################
# modules/comment-div-wrapper.pl
################################################################################
Comments:
################################################################################
# modules/commentcount.pl
################################################################################
@@ -711,6 +707,11 @@ Comments on
Kommentarer till
Comment on
Kommentar till
################################################################################
# modules/comment-div-wrapper.pl
################################################################################
Comments:
################################################################################
# modules/compilation.pl
################################################################################
@@ -1205,6 +1206,8 @@ Your mail subscriptions
All mail subscriptions
All mail subscribers
Subscriptions
Email:
@@ -1231,6 +1234,8 @@ 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.
@@ -1304,6 +1309,11 @@ 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
################################################################################
@@ -1323,11 +1333,6 @@ 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
################################################################################
@@ -1413,6 +1418,11 @@ 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
################################################################################
@@ -1477,6 +1487,17 @@ 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
################################################################################
@@ -1486,22 +1507,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
################################################################################
@@ -1518,35 +1539,33 @@ 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
list tags
Bygg om tagg index
tag cloud
taggmoln
################################################################################
# modules/templates.pl
################################################################################
@@ -1556,41 +1575,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
################################################################################
@@ -1600,7 +1619,7 @@ Innehåll
# modules/today.pl
################################################################################
Create a new page for today
Skapa en ny sida för idag
################################################################################
# modules/translation-links.pl
################################################################################
@@ -1641,15 +1660,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
################################################################################
@@ -1676,7 +1695,7 @@ Wanted Pages
# modules/webapp.pl
################################################################################
Web application for offline browsing
Webbapplikation för off-line visning
################################################################################
# modules/webdav.pl
################################################################################
@@ -1691,15 +1710,68 @@ 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

@@ -213,13 +213,8 @@ sub ISBN {
$num =~ s/[- ]//g;
my $len = length($num);
return "ISBN $rawnum" unless $len == 10 or $len == 13 or $len = 14; # be prepared for 2007-01-01
my $first = $q->a({-href => Ts('http://search.barnesandnoble.com/booksearch/isbninquiry.asp?ISBN=%s', $num)},
my $html = $q->a({-href => Ts("https://en.wikipedia.org/wiki/Special:BookSources/%s", $num)},
"ISBN " . $rawprint);
my $second = $q->a({-href => Ts('http://www.amazon.com/exec/obidos/ISBN=%s', $num)},
T('alternate'));
my $third = $q->a({-href => Ts('http://www.pricescan.com/books/BookDetail.asp?isbn=%s', $num)},
T('search'));
my $html = "$first ($second, $third)";
$html .= ' ' if ($rawnum =~ / $/); # Add space if old ISBN had space.
return $html;
}

227
modules/webmention.pl Normal file
View File

@@ -0,0 +1,227 @@
# Copyright (C) 2004 Brock Wilcox <awwaiid@thelackthereof.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
# 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;
use LWP::UserAgent;
use Modern::Perl;
use XML::LibXML;
AddModuleDescription('webmention.pl', 'Webmention Server Extension');
# Specification: https://www.w3.org/TR/webmention/
our ($CommentsPrefix, $q, $HtmlHeaders, %Action, $QuestionaskerSecretKey,
@MyInitVariables, %IndexHash, $BannedContent, $UsePathInfo, $HomePage,
$Message, @MyAdminCode, $FullUrlPattern);
push(@MyInitVariables, \&WebmentionServerAddLink, \&WebmentionAddAction);
# Add webmentions metadata to our pages
sub WebmentionServerAddLink {
$Message .= T('Webmention module requires $CommentsPrefix to be set') unless $CommentsPrefix;
# only allow linking to reasonable pages: no URL parameters!
my @params = $q->param;
return unless GetParam('action', 'browse') eq 'browse';
return if GetParam('revision');
my $id = GetId() || $HomePage;
return if $id =~ /^$CommentsPrefix/;
my $link = '<link rel="webmention" type="application/wiki" href="'
. ScriptUrl('webmention/' . UrlEncode($id)) . '" />';
$HtmlHeaders .= $link unless $HtmlHeaders =~ /rel="webmention"/;
}
sub WebmentionAddAction {
SetParam('action', 'webmention') if $q->path_info =~ m|/webmention\b|;
}
# Process incoming webmentions
$Action{webmention} = \&DoWebmentionServer;
sub DoWebmentionServer {
my $id = FreeToNormal(shift);
# some sanity checks for the request
if ($q->request_method() ne 'POST') {
ReportError(T('Webmention requires a POST request'), '400 BAD REQUEST');
}
if ($q->content_type() ne 'application/x-www-form-urlencoded') {
ReportError(T('Webmention requires x-www-form-urlencoded requests'), '400 BAD REQUEST');
}
# some sanity checks for the target page name
if (not $id) {
ReportError(T('Webmention must mention a specific page'), '400 BAD REQUEST');
}
my $error = ValidId($id);
if ($error) {
ReportError(T('Webmention must mention a valid page'), '400 BAD REQUEST');
}
# check the IP number for bans
my $rule = UserIsBanned();
if ($rule) {
ReportError(Ts('Your IP number is blocked: %s', $rule), '403 FORBIDDEN');
}
# check that the target page exists
AllPagesList();
if (not $IndexHash{$id}) {
ReportError(T('Webmention must mention an existing page'), '404 NOT FOUND');
}
# verify parameters
my $source = GetParam('source', undef) or ReportError(T('Webmention must mention source'), '400 BAD REQUEST');
my $target = GetParam('target', undef) or ReportError(T('Webmention must mention target'), '400 BAD REQUEST');
# verify that the source isn't banned
$rule = BannedContent($source);
if ($rule) {
ReportError(Ts('The URL is blocked: %s', $rule), '403 FORBIDDEN');
}
# verify that the webmention is legit
my $ua = LWP::UserAgent->new(agent => 'Oddmuse Webmention Server/0.1');
my $response = $ua->get($source);
if (not $response->is_success) {
ReportError(Tss('Webmention source cannot be verified: %1 returns %2 %3',
$source, $response->code, $response->message), '400 BAD REQUEST');
}
my $self = ScriptUrl(UrlEncode($id));
if ($response->decoded_content !~ /$self/) {
ReportError(Ts('Webmention source does not link to %s', $self), '400 BAD REQUEST');
}
$id = $CommentsPrefix . $id;
if (GetPageContent($id) =~ /$source/) {
ReportError(Ts('Webmention for %s already exists', $source), '400 BAD REQUEST');
}
# try to determine a name and a link
my ($username, $homepage);
my $parser = XML::LibXML->new(recover => 2);
my $dom = $parser->load_html(string => $response->decoded_content);
my @nodes = $dom->findnodes('//*[@rel="author"]');
if (@nodes) {
my $node = shift @nodes;
$username = $node->textContent;
$homepage = $node->getAttribute('href');
}
# post a comment without redirect at the end
SetParam('aftertext', 'Webmention: ' . $source);
SetParam('summary', 'Webmention');
SetParam('username', $username || T('Anonymous'));
SetParam('homepage', $homepage);
SetParam($QuestionaskerSecretKey, 1) if $QuestionaskerSecretKey;
local *ReBrowsePage = sub {};
DoPost($id);
# response
print GetHeader('', T('Webmention OK!'));
print $q->start_div({-class=>'content webmention'}),
$q->p(GetPageLink($BannedContent)),
$q->end_div;
PrintFooter();
}
# Allow user to webmention other sites
push(@MyAdminCode, \&WebmentionMenu);
sub WebmentionMenu {
my ($id, $menuref, $restref) = @_;
if ($id) {
push(@$menuref, ScriptLink('action=webmentions;id=' . $id, T('Add webmentions'), 'webmentions'));
}
}
$Action{webmentions} = \&DoWebmentionMenu;
sub DoWebmentionMenu {
my $id = GetId();
ValidIdOrDie($id);
print GetHeader('', Ts('Webmentioning others from %s', NormalToFree($id)), '');
my $text = GetPageContent($id);
my @urls = $text =~ /$FullUrlPattern/g;
if (@urls) {
print GetFormStart();
print GetHiddenValue('action', 'webmentioning');
print GetHiddenValue('from', UrlEncode($id));
print '<p>';
print $q->checkbox_group('to', \@urls, undef, 'true');
print '</p>';
print $q->submit('go', T('Webmention!'));
} else {
print $q->p(T('No links found.'));
}
PrintFooter();
}
$Action{webmentioning} = \&DoWebmention;
sub DoWebmention {
my $id = GetParam('from');
ValidIdOrDie($id);
my $from = ScriptUrl($id);
my @to = $q->multi_param('to');
ReportError('Missing target') unless @to;
print GetHeader('', Ts('Webmentioning somebody from %s', NormalToFree($id)), '');
for my $to (@to) {
Webmention($from, $to);
}
PrintFooter();
}
sub Webmention {
my ($from, $to) = @_;
ReportError('Target must be an URL', '400 BAD REQUEST', 0, $q->p($to)) unless $to =~ /$FullUrlPattern/;
my $ua = LWP::UserAgent->new(agent => "Oddmuse Webmention Client/0.1");
print $q->p(Ts('Contacting %s', $to));
my $response = $ua->get($to);
if (!$response->is_success) {
print $q->p(Ts('Target reports an error: %s', $response->status_line));
return;
}
print $q->p("Parsing response");
my $data = $response->decoded_content;
my $parser = XML::LibXML->new(recover => 2);
my $dom = $parser->load_html(string => $data);
my $webmention = $dom->findvalue('//link[@rel="webmention"]/@href');
if (!$webmention) {
print $q->p(T('No Webmention URL found'));
return;
}
print $q->p("Webmention URL is $webmention");
$response = $ua->post($webmention, { source => $from, target => $to });
my $message = $response->code . " " . $response->message;
if ($response->is_success) {
print $q->p(Ts("Success: %s", $message));
} else {
print $q->p(Ts("Failure: %s", $message));
$dom = $parser->load_html(string => $response->decoded_content());
for my $node ($dom->getElementsByTagName('script')) { $node->parentNode->removeChild($node) };
for my $node ($dom->getElementsByTagName('style')) { $node->parentNode->removeChild($node) };
print $q->p($dom->textContent);
}
}

61
modules/wordcount.pl Normal file
View File

@@ -0,0 +1,61 @@
# Copyright (C) 2005 Robin V. Stacey (robin@greywulf.net)
#
# 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 2 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, write to the
# Free Software Foundation, Inc.
# 59 Temple Place, Suite 330
# Boston, MA 02111-1307 USA
# This module adds a wordcount to the bottom of edit boxes. The javascript code is munged from
# Richard Livsey's Textarea Tools page: http://livsey.org/experiments/textareatools/
# Though I've stripped it down to it's barest necessities
use strict;
use v5.10;
our (@MyInitVariables, $HtmlHeaders, $EditNote);
AddModuleDescription('wordcount.pl', 'Word Count Extension');
push(@MyInitVariables, \&WordcountAddScript);
sub WordcountAddScript {
$HtmlHeaders .= "<script type='text/javascript'>
function addEvent(obj, evType, fn) {
if (obj.addEventListener) {
obj.addEventListener(evType, fn, true);
return true;
} else if (obj.attachEvent) {
var r = obj.attachEvent('on'+evType, fn);
return r;
} else { return false; }
}
addEvent(window, 'load', function() {
document.getElementById('textWordCount').innerHTML = numWords(document.getElementById('text').value);
document.getElementById('text').onkeyup = function() {
document.getElementById('textWordCount').innerHTML = numWords(document.getElementById('text').value);
}
});
function numWords(string) {
string = string + ' ';
string = string.replace(/^[^A-Za-z0-9]+/gi, '');
string = string.replace(/[^A-Za-z0-9]+/gi, ' ');
var items = string.split(' ');
return items.length -1;
}
</script>";
}
$EditNote = "Words: <span id='textWordCount'></span>" . $EditNote;

94
scripts/ip-to-regexp.pl Normal file
View File

@@ -0,0 +1,94 @@
use Modern::Perl;
use Net::Whois::Parser qw/parse_whois/;
sub main {
my $ip = shift(@ARGV);
die "Provide an IP number as argument.\n" unless $ip;
print get_regexp_ip(get_range($ip)), "\n";
}
sub get_range {
my $ip = shift;
my $response = parse_whois(domain => $ip);
my $re = '(?:[0-9]{1,3}\.){3}[0-9]{1,3}';
my ($start, $end) = $response->{inetnum} =~ /($re) *- *($re)/;
return $start, $end;
}
sub get_groups {
my ($from, $to) = @_;
my @groups;
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
}
}
return \@groups;
}
sub get_regexp_range {
my @chars;
for my $group (@{get_groups(@_)}) {
my ($from, $to) = @$group;
my $char;
for (my $i = length($from); $i >= 1; $i--) {
if (substr($from, - $i, 1) eq substr($to, - $i, 1)) {
$char .= substr($from, - $i, 1);
} else {
$char .= '[' . substr($from, - $i, 1) . '-' . substr($to, - $i, 1). ']';
}
}
push(@chars, $char);
}
return join('|', @chars);
}
sub get_regexp_ip {
my ($from, $to) = @_;
my @start = split(/\./, $from);
my @end = split(/\./, $to);
my $regexp = "^";
for my $i (0 .. 3) {
if ($start[$i] eq $end[$i]) {
$regexp .= $start[$i];
} elsif ($start[$i] eq '0' and $end[$i] eq '255') {
last;
} 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 {
$regexp .= '(' . get_regexp_range($start[$i], $end[$i]) . ')$';
last;
}
$regexp .= '\.' if $i < 3;
}
return $regexp;
}
main();

View File

@@ -1,5 +1,5 @@
#! /usr/bin/perl
# Copyright (C) 20102018 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20102019 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
@@ -22,6 +22,8 @@ use MIME::Entity;
use File::Temp;
use File::Basename;
use File::Path;
use Net::SMTP;
use Authen::SASL qw(Perl);
# This script can be invoked as follows:
# perl rc2mail.pl -r http://localhost/cgi-bin/wiki \
@@ -36,7 +38,8 @@ use File::Path;
# gets http://localhost/cgi-bin/wiki?action=rss;days=1;full=1;short=0
# And http://localhost/cgi-bin/wiki?action=subscriptionlist;raw=1;pwd=foo
# -m user:password@mailhost for sending email using SMTP Auth. Without this
# information, the script will send mail to localhost.
# information, the script will send mail to localhost. The host can end
# in a port number, e.g. "kensanata:*secret*@smtp.migadu.com:587"
# -f email address to use as the sender.
# -t timestamp file; it's last modified date is used to determine when the
# the last run was and an appropriate URL is used. Instead of days=1 it
@@ -170,37 +173,20 @@ sub send_mail {
Path => $fh,
Type=> "text/html");
if ($host) {
print "Sending $title to $subscriber using ${user}\@${host}\n" if $verbose;
eval {
require Net::SMTP::TLS;
my $smtp = Net::SMTP::TLS->new($host,
User => $user,
Password => $password);
$smtp->mail($from);
$smtp->to($subscriber);
print "$root\nSending $title to $subscriber using ${user}\@${host}\n" if $verbose;
my $smtp = Net::SMTP->new($host, Debug => $debug);
$smtp->starttls();
# the following requires Authen::SASL!
$smtp->auth($user, $password);
$smtp->mail($from);
if ($smtp->to($subscriber)) {
$smtp->data;
$smtp->datasend($mail->stringify);
$smtp->dataend;
$smtp->quit;
};
if ($@) {
require Net::SMTP::SSL;
my $smtp = Net::SMTP::SSL->new($host, Port => 465);
$smtp->auth($user, $password);
$smtp->mail($from);
$smtp->to($subscriber);
$smtp->data;
$smtp->datasend($mail->stringify);
$smtp->dataend;
$smtp->quit;
}
} else {
my @recipients = $mail->smtpsend();
if (@recipients) {
print "Sent $title to ", join(', ', @recipients), "\n" unless $quiet;
} else {
print "Failed to send $title to $subscriber\n" unless $quiet;
warn "Error: ", $smtp->message();
}
$smtp->quit;
}
}

91
scripts/stats.pl Executable file
View File

@@ -0,0 +1,91 @@
#! /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

@@ -1,24 +1,41 @@
#!/usr/bin/env perl
use Modern::Perl;
use Mojolicious::Lite;
use Mojo::Cache;
use Archive::Tar;
use File::Basename;
use Sort::Versions;
use Encode qw(decode_utf8);
my $dir = "/home/alex/oddmuse.org/releases";
my $cache = Mojo::Cache->new(max_keys => 50);
get '/' => sub {
my $c = shift;
my @tarballs = sort map {
sub tarballs {
my @tarballs = reverse sort versioncmp map {
my ($name, $path, $suffix) = fileparse($_, '.tar.gz');
$name;
} <$dir/*.tar.gz>;
$c->render(template => 'index', tarballs => \@tarballs);
return \@tarballs;
}
sub tarball {
my $tarball = shift;
if ($tarball eq 'latest') {
my $tarballs = tarballs();
$tarball = shift @$tarballs;
}
return $tarball;
}
get '/' => sub {
my $c = shift;
my $tarballs = tarballs();
unshift @$tarballs, 'latest';
$c->render(template => 'index', tarballs => $tarballs);
} => 'main';
get '/#tarball' => sub {
my $c = shift;
my $tarball = $c->param('tarball');
my $tarball = tarball $c->param('tarball');
my $files = $cache->get($tarball);
if (not $files) {
$c->app->log->info("Reading $tarball.tar.gz");
@@ -36,7 +53,7 @@ get '/#tarball' => sub {
get '/#tarball/#file' => sub {
my $c = shift;
my $tarball = $c->param('tarball');
my $tarball = tarball $c->param('tarball');
my $file = $c->param('file');
my $text = $cache->get("$tarball/$file");
if (not $text) {
@@ -68,7 +85,9 @@ 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>

120
scripts/unsubscribe.pl Normal file
View File

@@ -0,0 +1,120 @@
#! /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;

84
scripts/webmention.pl Normal file
View File

@@ -0,0 +1,84 @@
#! /usr/bin/perl -w
# 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
# 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 Webmention from one site to another
If you link from page A on your site to page B on some other site, you can
invoke this script with the command-line arguments A and B. In theory, this will
create a link back from B to A, letting them and all their visitors know that
you wrote something in response.
=cut
use Modern::Perl;
use XML::LibXML;
use LWP::UserAgent;
use Data::Dumper;
if (@ARGV != 2) {
die "Usage: webmention FROM TO\n";
}
my $parser = XML::LibXML->new(recover => 2);
my ($from, $to) = @ARGV;
my $ua = LWP::UserAgent->new(agent => "Oddmuse Webmention Client/0.1");
print "Getting $from\n";
my $response = $ua->get($from);
if (!$response->is_success) {
die $response->status_line;
}
print "Parsing $from\n";
my ($username, $homepage);
my $dom = $parser->load_html(string => $response->decoded_content);
my @nodes = $dom->findnodes('//*[@rel="author"]');
if (@nodes) {
my $node = shift @nodes;
$username = $node->textContent;
$homepage = $node->getAttribute('href');
}
print "Webmention from " . join(", ", $username, $homepage) . "\n"
if $username or $homepage;
print "Getting $to\n";
$response = $ua->get($to);
if (!$response->is_success) {
die $response->status_line;
}
print "Parsing $to\n";
$dom = $parser->load_html(string => $response->decoded_content);
my $webmention = $dom->findvalue('//link[@rel="webmention"]/@href');
if (!$webmention) {
die "Webmention URL not found in $to\n";
}
print "Webmention URL is $webmention\n";
$response = $ua->post($webmention, { source => $from, target => $to });
my $message = $response->code . " " . $response->message . "\n";
if ($response->is_success) {
print $message;
} else {
die $message;
}

View File

@@ -3,3 +3,66 @@ Extra Files
Some of the modules requires extra files -- graphics, templates, and
so on.
Gopher Server
-------------
Example usage:
Change your working directory to the root of the Oddmuse repository
(the parent directory of this directory).
Set the environment variable `WikiDataDir` to `test-data`:
```
export WikiDataDir=test-data
```
Test that the simple web server works by running `stuff/server.pl`.
This should start the web server on `http://localhost:8080/`. Visit
the link using your web browser and edit `HomePage`.
You should see a `test-data` directory containing the new page.
Now start the gopher server on port 7070 by running
`stuff/gopher-server.pl --port=7070`. If you don't provide an explicit
port a random port is used and you'll need to read the server output
to determine the actual port. That's why we're setting the port
ourselves. Remember that using ports below 1024 require special
privileges. Don't use them unless you know what you're doing.
Test the gopher server by simulating a request using `echo HomePage |
nc localhost 7070`. You should get back the content of the page you
wrote.
Let's test encryption. Create a self-signed certificate and a private
key. If you use the following command, you can leave all the fields
empty except for the common name. The common name you provide must
match the server name you are using. In our case, that would be
`localhost`.
```
openssl req -new -x509 -days 365 -nodes -out \
gopher-server-cert.pem -keyout gopher-server-key.pem
```
Start the gopher server on port 7443 using this information with
`stuff/gopher-server.pl --port=7443
--wiki_key_file=gopher-server-key.pem
--wiki_cert_file=gopher-server-cert.pem`.
If you test this by simulating an unencrypted request using `echo
HomePage | nc localhost 7443`, you shouldn't get any output. Use `echo
HomePage | gnutls-cli --no-ca-verification localhost:7443` and you
should get back your page. Actually, you have the certificate right
there so you might as well provide it: `echo HomePage | gnutls-cli
--x509cafile=gopher-server-cert.pem localhost:7443`
What you'd expect to see is a lot of cryptography output by
`gnutls-cli` and at the very end the content of the page. If you're
seeing `Fatal error: Error in the pull function` instead, then perhaps
the timing of things is a bit off. Introducing a short wait fixed this
for me. `(sleep 1;echo HomePage) | gnutls-cli
--x509cafile=gopher-server-cert.pem localhost:7443`
Good luck!

1036
stuff/gemini-server.pl Executable file

File diff suppressed because it is too large Load Diff

View File

@@ -1,5 +1,5 @@
#!/usr/bin/env perl
# Copyright (C) 20172018 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20172019 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
@@ -82,6 +82,10 @@ sub post_configure_hook {
$self->log(3, "PID $$");
$self->log(3, "Host " . ("@{$self->{server}->{host}}" || "*"));
$self->log(3, "Port @{$self->{server}->{port}}");
# Note: if you use sudo to run gopher-server.pl, these options might not work!
$self->log(4, "--wikir_dir says $self->{server}->{wiki_dir}\n");
$self->log(4, "\$WikiDataDir says $ENV{WikiDataDir}\n");
$self->log(3, "Wiki data dir is $DataDir\n");
$RunCGI = 0;
@@ -121,7 +125,7 @@ wiki_key_file - the filename containing a private key in PEM format
For many of the options, more information can be had in the Net::Server
documentation. This is important if you want to daemonize the server. You'll
need to use --pid_file so that you can stop it using a script, --setsid to
daemonize it, --log_file to write keep logs, and you'll net to set the user or
daemonize it, --log_file to write keep logs, and you'll need to set the user or
group using --user or --group such that the server has write access to the data
directory.
@@ -192,6 +196,14 @@ sub normal_to_free {
return $title;
}
sub free_to_normal {
my $title = shift;
$title =~ s/^ +//g;
$title =~ s/ +$//g;
$title =~ s/ +/_/g;
return $title;
}
sub print_text {
my $self = shift;
my $text = shift;
@@ -238,17 +250,17 @@ sub serve_main_menu {
my @pages = sort { $b cmp $a } grep(/^\d\d\d\d-\d\d-\d\d/, @IndexList);
# we should check for pages marked for deletion!
for my $id (@pages[0..9]) {
$self->print_menu("1" . normal_to_free($id), "$id/menu");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/menu");
}
$self->print_menu("1" . "More...", "do/more");
$self->print_info("");
for my $id (@{$self->{server}->{wiki_pages}}) {
$self->print_menu("1" . normal_to_free($id), "$id/menu");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/menu");
}
for my $id (@{$self->{server}->{menu}}) {
$self->print_menu("1" . normal_to_free($id), "map/$id");
$self->print_menu("1" . normal_to_free($id), "map/" . free_to_normal($id));
}
$self->print_menu("1" . "Recent Changes", "do/rc");
@@ -271,7 +283,7 @@ sub serve_phlog_archive {
$self->log(3, "Serving phlog archive");
my @pages = sort { $b cmp $a } grep(/^\d\d\d\d-\d\d-\d\d/, @IndexList);
for my $id (@pages) {
$self->print_menu("1" . normal_to_free($id), "$id/menu");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/menu");
}
}
@@ -279,7 +291,7 @@ sub serve_index {
my $self = shift;
$self->log(3, "Serving index of all pages");
for my $id (sort newest_first @IndexList) {
$self->print_menu("1" . normal_to_free($id), "$id/menu");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/menu");
}
}
@@ -290,7 +302,7 @@ sub serve_match {
$self->print_info("Use a regular expression to match page titles.");
$self->print_info("Spaces in page titles are underlines, '_'.");
for my $id (sort newest_first grep(/$match/i, @IndexList)) {
$self->print_menu( "1" . normal_to_free($id), "$id/menu");
$self->print_menu( "1" . normal_to_free($id), free_to_normal($id) . "/menu");
}
}
@@ -301,7 +313,7 @@ sub serve_search {
$self->print_info("Use regular expressions separated by spaces.");
SearchTitleAndBody($str, sub {
my $id = shift;
$self->print_menu("1" . normal_to_free($id), "$id/menu");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/menu");
});
}
@@ -315,7 +327,7 @@ sub serve_tags {
$count{$tag} = @{$h{$tag}};
}
foreach my $id (sort { $count{$b} <=> $count{$a} } keys %count) {
$self->print_menu("1" . normal_to_free($id), "$id/tag");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/tag");
}
}
@@ -342,7 +354,7 @@ sub serve_rc {
sub {
my($id, $ts, $author_host, $username, $summary, $minor, $revision,
$languages, $cluster, $last) = @_;
$self->print_menu("1" . normal_to_free($id), "$id/menu");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/menu");
for my $line (split(/\n/, wrap(' ', ' ', $summary))) {
$self->print_info($line);
}
@@ -395,9 +407,9 @@ sub serve_page_comment_link {
# sometimes we are on a comment page and cannot derive the original
$self->print_menu("1" . "Back to the original page",
"$original/menu") if $original;
$self->print_menu("w" . "Add a comment", "$id/append/text");
$self->print_menu("w" . "Add a comment", free_to_normal($id) . "/append/text");
} else {
my $comments = $CommentsPrefix . $id;
my $comments = free_to_normal($CommentsPrefix . $id);
$self->print_menu("1" . "Comments on this page", "$comments/menu");
}
}
@@ -408,7 +420,7 @@ sub serve_page_history_link {
my $id = shift;
my $revision = shift;
if (not $revision) {
$self->print_menu("1" . "Page History", "$id/history");
$self->print_menu("1" . "Page History", free_to_normal($id) . "/history");
}
}
@@ -420,7 +432,7 @@ sub serve_file_page_menu {
my $code = substr($type, 0, 6) eq 'image/' ? 'I' : '9';
$self->log(3, "Serving file page menu for " . UrlEncode($id));
$self->print_menu($code . normal_to_free($id)
. ($revision ? "/$revision" : ""), $id);
. ($revision ? "/$revision" : ""), free_to_normal($id));
$self->serve_page_comment_link($id, $revision);
$self->serve_page_history_link($id, $revision);
}
@@ -430,16 +442,16 @@ sub serve_text_page_menu {
my $id = shift;
my $page = shift;
my $revision = shift;
$self->log(3, "Serving text page menu for " . UrlEncode($id)
$self->log(3, "Serving text page menu for $id"
. ($revision ? "/$revision" : ""));
$self->print_info("The text of this page:");
$self->print_menu("0" . normal_to_free($id),
$id . ($revision ? "/$revision" : ""));
free_to_normal($id) . ($revision ? "/$revision" : ""));
$self->print_menu("h" . normal_to_free($id),
$id . ($revision ? "/$revision" : "") . "/html");
free_to_normal($id) . ($revision ? "/$revision" : "") . "/html");
$self->print_menu("w" . "Replace " . normal_to_free($id),
$id . "/write/text");
free_to_normal($id) . "/write/text");
$self->serve_page_comment_link($id, $revision);
$self->serve_page_history_link($id, $revision);
@@ -448,35 +460,47 @@ sub serve_text_page_menu {
while ($page->{text} =~ /
\[\[ (?<title>[^\]|]*) (?:\|(?<text>[^\]]*))? \]\]
| \[ (?<url>https?:\/\/\S+) \s+ (?<text>[^\]]*) \]
| (?<url>https?:\/\/\S+)
| \[ (?<text>[^\]]*) \] \( (?<url>https?:\/\/\S+) \)
| \[ gopher:\/\/ (?<hostname>[^:\/]*) (?::(?<port>\d+))?
(?:\/(?<type>\d) (?<selector>\S+))?
\s+ (?<text>[^\]]+)\]
| \[ gophers?:\/\/ (?<hostname>[^:\/]*) (?::(?<port>\d+))?
(?:\/(?<type>\d)? (?<selector>\S+))? \]
| \[ gophers?:\/\/ (?<hostname>[^:\/]*) (?::(?<port>\d+))?
(?:\/(?<type>\d)? (?<selector>\S+))?
\s+ (?<text>[^\]]+) \]
| \[ (?<text>[^\]]+) \]
\( gopher:\/\/ (?<hostname>[^:\/]*) (?::(?<port>\d+))?
(?:\/(?<type>\d) (?<selector>\S+))? \)
\( gophers?:\/\/ (?<hostname>[^:\/]*) (?::(?<port>\d+))?
(?:\/(?<type>\d)? (?<selector>\S+))? \)
/xg) {
# remember $type can be "0" and thus "false" -- use // and defined instead!
my ($title, $text, $url, $hostname,
$port, $type, $selector)
= ($+{title}, $+{text}, $+{url}, $+{hostname},
$+{port}||70, $+{type}||1, $+{selector});
$+{port}||70, $+{type}//1, $+{selector});
$title =~ s/\n/ /g;
$text =~ s/\n/ /g;
if ($first) {
$self->print_info("");
$self->print_info("Links leaving " . normal_to_free($id) . ":");
$first = 0;
}
if ($hostname) {
if ($hostname and $text) {
$self->print_text(join("\t", $type . $text, $selector, $hostname, $port) . "\r\n");
} elsif ($url) {
} elsif ($hostname and $selector) {
$self->print_text(join("\t", "$type$hostname:$port/$type$selector", $selector, $hostname, $port) . "\r\n");
} elsif ($hostname) {
$self->print_text(join("\t", "1$hostname:$port", $selector, $hostname, $port) . "\r\n");
} elsif ($url and $text) {
$self->print_menu("h$text", "URL:" . $url, undef, undef, 1);
} elsif ($url) {
$self->print_menu("h$url", "URL:" . $url, undef, undef, 1);
} elsif ($title and substr($title, 0, 4) eq 'tag:') {
$self->print_menu("1" . ($text||substr($title, 4)),
substr($title, 4) . "/tag");
free_to_normal(substr($title, 4)) . "/tag");
} elsif ($title =~ s!^image[/a-z]* external:!pics/!) {
$self->print_menu("I" . $text||$title, $title);
$self->print_menu("I" . $text||$title, $title); # do not normalize space
} elsif ($title) {
$title =~ s!^image[/a-z]*:!!i;
$self->print_menu("1" . ($text||$title), $title . "/menu");
$self->print_menu("1" . ($text||$title), free_to_normal($title) . "/menu");
}
}
@@ -506,7 +530,7 @@ sub serve_page_history {
$self->log(3, "Serving history of " . UrlEncode($id));
OpenPage($id);
$self->print_menu("1" . normal_to_free($id) . " (current)", "$id/menu");
$self->print_menu("1" . normal_to_free($id) . " (current)", free_to_normal($id) . "/menu");
$self->print_info(CalcTime($Page{ts})
. " by " . GetAuthor($Page{username})
. ($Page{summary} ? ": $Page{summary}" : "")
@@ -515,7 +539,7 @@ sub serve_page_history {
foreach my $revision (GetKeepRevisions($OpenPageName)) {
my $keep = GetKeptRevision($revision);
$self->print_menu("1" . normal_to_free($id) . " ($keep->{revision})",
"$id/$keep->{revision}/menu");
free_to_normal($id) . "/$keep->{revision}/menu");
$self->print_info(CalcTime($keep->{ts})
. " by " . GetAuthor($keep->{username})
. ($keep->{summary} ? ": $keep->{summary}" : "")
@@ -660,7 +684,7 @@ sub serve_tag_list {
my $tag = shift;
$self->print_info("Search result for tag $tag:");
for my $id (sort newest_first TagFind($tag)) {
$self->print_menu("1" . normal_to_free($id), "$id/menu");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/menu");
}
}
@@ -670,7 +694,7 @@ sub serve_tag {
$self->log(3, "Serving tag " . UrlEncode($tag));
if ($IndexHash{$tag}) {
$self->print_info("This page is about the tag $tag.");
$self->print_menu("1" . normal_to_free($tag), "$tag/menu");
$self->print_menu("1" . normal_to_free($tag), free_to_normal($tag) . "/menu");
$self->print_info("");
}
$self->serve_tag_list($tag);
@@ -708,7 +732,7 @@ sub write_page_ok {
my $self = shift;
my $id = shift;
$self->print_info("Page was saved.");
$self->print_menu("1" . normal_to_free($id), "$id/menu");
$self->print_menu("1" . normal_to_free($id), free_to_normal($id) . "/menu");
}
sub write_page_error {

4
stuff/hypnotoad.pl Normal file
View File

@@ -0,0 +1,4 @@
use Mojo::Server::Hypnotoad;
warn "Use hypnotoad -s stuff/hypnotoad.pl to stop the server\n";
my $hypnotoad = Mojo::Server::Hypnotoad->new;
$hypnotoad->run('stuff/mojolicious-app.pl');

17
stuff/mojolicious-app.pl Normal file
View File

@@ -0,0 +1,17 @@
# From the root directory, run one of the following:
# 1. stuff/mojolicious-app.pl daemon -l http://localhost:8080
# 2. stuff/hypnotoad.pl
# 3. stuff/toadfarm.pl start
use Mojolicious::Lite;
plugin CGI => {
support_semicolon_in_query_string => 1,
};
plugin CGI => {
route => '/',
script => 'wiki.pl',
};
app->start;

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", "master") == 0
or die "Failed to git checkout master\n";
system("git", "checkout", "main") == 0
or die "Failed to git checkout main\n";

29
stuff/server.pl Normal file → Executable file
View File

@@ -1,4 +1,4 @@
#!/bin/env perl
#!/usr/bin/env perl
# Copyright (C) 2015 Alex Schroeder <alex@gnu.org>
# This program is free software: you can redistribute it and/or modify it under
@@ -13,6 +13,23 @@
# You should have received a copy of the GNU General Public License along with
# this program. If not, see <http://www.gnu.org/licenses/>.
# What is this?
# =============
#
# This is a script that will server a wiki using a web server written in Perl,
# without a fancy framework like Mojolicious. Instead, it uses
# HTTP::Server::Simple::CGI.
#
# A simple usecase would be that you have had a wiki running years ago but then
# you forgot all about it and your Apache config no longer works and who knows
# how the system Perl is doing. So check out the data dir and notice that the
# files belong to a user called _www... And so you run the following:
#
# sudo -u _www perl stuff/server.pl ./wiki.pl 3000 \
# /Users/alex/WebServer/Oddmuse
#
# Your old wiki is served on localhost:3000 for you to examine.
my $wiki = $ARGV[0] || './wiki.pl';
my $port = $ARGV[1] || 8080;
my $dir = $ARGV[2];
@@ -33,6 +50,10 @@ $ENV{WikiDataDir} = $dir if $dir;
package OddMuse;
$q = shift;
# The equivalent of use CGI qw(-utf8) because it didn't work as part of
# cgi_init.
$CGI::PARAM_UTF8++;
# NPH, or "no-parsed-header", scripts bypass the server completely by
# sending the complete HTTP header directly to the browser.
$q->nph(1);
@@ -44,10 +65,10 @@ $ENV{WikiDataDir} = $dir if $dir;
die <<'EOT' unless -f $wiki;
Usage: perl server.pl [WIKI [PORT [DIR]]]
Example: perl server.pl wiki.pl 8080 ~/src/oddmuse/test-data
Example: perl server.pl ./wiki.pl 8080 ~/src/oddmuse/test-data
You may provide the Oddmuse wiki script on the command line. If you do not
provide it, WIKI will default to 'wiki.pl'.
provide it, WIKI will default to './wiki.pl'.
You may provide a port number on the command line. If you do not provide it,
PORT will default to 8080.
@@ -67,7 +88,7 @@ echo <<EOF > "$WikiDataDir/config"
$AdminPass = 'foo';
$ScriptName = 'http://localhost/';
EOF
perl stuff/server.pl wiki.pl &
perl stuff/server.pl ./wiki.pl &
SERVER=$!
sleep 1
w3m http://localhost:8080/

8
stuff/toadfarm.pl Normal file
View File

@@ -0,0 +1,8 @@
use Toadfarm -init;
mount "stuff/mojolicious-app.pl" => {
"Host" => qr{^localhost:8080$},
mount_point => '/',
};
start;

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20062015 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20062019 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
@@ -138,5 +138,6 @@ sub trim {
s/\s+$//g;
return $_;
}
ok(trim($result->content->body) eq ("<p>" . trim($content) . '</p>'), 'verify content');
my $re = "<p>" . trim($content) . '</p>';
like($result->content->body, qr/$re/, 'verify content');
ok($result->author->name eq $username, 'verify author');

View File

@@ -15,13 +15,42 @@
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])|5[7-9]|6[0-9]|70)\.',
'^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.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;
@@ -57,10 +86,9 @@ 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 () [ - ]'));
quotemeta('127.0.0.1 () [127.0.0.0 - 127.255.255.255]'));
SKIP: {
skip "Net::Whois::Parser doesn't always return the same result", 4;
@@ -73,7 +101,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><div class="footer">');
'</pre></div><p>warrior</p></div><div class="wrapper close"></div></div><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><div class="footer">');
'</pre></div></div><p>warrior</p></div><div class="wrapper close"></div></div><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><div class="footer">');
'</pre></div></div><p>warrior</p></div><div class="wrapper close"></div></div><footer>');
xpath_test(get_page('action=calendar'),
# yearly navigation

View File

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

View File

@@ -100,7 +100,7 @@ bla
quotemeta(qq{<div class="crossbar"><p>bla</p><h2>mu</h2>}),
quotemeta(qq{<p>bla </p><div class="toc"><h2>$TocHeaderText</h2>}),
quotemeta(qq{<ol><li><a href="#${TocAnchorPrefix}1">two</a><ol><li><a href="#${TocAnchorPrefix}2">three</a></li></ol></li><li><a href="#${TocAnchorPrefix}3">one</a></li></ol>}),
quotemeta(qq{one</a></li></ol></div></div><div class="content browse"><p>bla}));
quotemeta(qq{one</a></li></ol></div></div><div class="content browse" lang="en"><p>bla}));
quotemeta(qq{<h2 id="${TocAnchorPrefix}1">two</h2>}),
quotemeta(qq{<h2 id="${TocAnchorPrefix}3">one</h2>}),

41
t/definition-lists.t Normal file
View File

@@ -0,0 +1,41 @@
# 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
# 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;
add_module('definition-lists.pl');
run_tests(split('\n',<<'EOT'));
this is a test\n\na test!
this is a test<p>a test!</p>
test\n: some definition
<dl><dt>test</dt><dd>some definition</dd></dl>
test\n: some definition\nand some text
<dl><dt>test</dt><dd>some definition and some text</dd></dl>
test\n: some definition\n\nbut this is not
<dl><dt>test</dt><dd>some definition</dd></dl><p>but this is not</p>
an introduction\n\ntest\n: some definition
an introduction<dl><dt>test</dt><dd>some definition</dd></dl>
test\n: some definition\nand this\n: is another definition
<dl><dt>test</dt><dd>some definition</dd><dt>and this</dt><dd>is another definition</dd></dl>
test\n: some definition\n: another definition
<dl><dt>test</dt><dd>some definition</dd><dd>another definition</dd></dl>
test\n: some definition\n\nand this\n: is another definition
<dl><dt>test</dt><dd>some definition</dd><dt>and this</dt><dd>is another definition</dd></dl>
EOT
done_testing();

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://www.duckduckgo.com/\?q=alex\+site%3Aemacswiki\.org');
'Location: https://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"]/div[@class="page h-entry"]/p[@class="comment"]/a[text()="Comments on this page"]');
'//div[@class="journal h-feed"]/article[@class="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"]/div[@class="page h-entry"]/p[@class="comment"]/a[@href="http://localhost/wiki.pl/Comments_on_2011-07-06"][text()="Add Comment"]');
'//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"]');
test_page(update_page('Comments_on_2011-07-06', 'Yo'),
'Yo');
xpath_test(get_page('Hi'),
'//div[@class="journal h-feed"]/div[@class="page h-entry"]/p[@class="comment"]/a[@href="javascript:togglecomments(\'id0\')"][text()="Comments on 2011-07-06"]');
'//div[@class="journal h-feed"]/article[@class="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"]/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\')"]');
'//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\')"]');

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::div[@class="footer"]',
'//div[@class="wrapper"]/following-sibling::footer',
);

340
t/gemini-server.t Normal file
View File

@@ -0,0 +1,340 @@
# 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) 20172018 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20172019 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
@@ -46,6 +46,7 @@ if (!defined $pid) {
my $secure_perl_path = $Config{perlpath};
exec($secure_perl_path,
"stuff/gopher-server.pl",
"--host=127.0.0.1",
"--port=$port",
"--log_level=0", # set to 4 for verbose logging
"--wiki=./wiki.pl",
@@ -300,16 +301,96 @@ like($page, qr/^0Zürich♥\tZ%c3%bcrich%e2%99%a5\t/m, "UTF-8 encoded text link"
like($page, qr/^1Üetliberg♥\t%c3%9cetliberg%e2%99%a5\/menu\t/m,
"UTF-8 encoded links");
# Space normalization
test_page(update_page('my_page', '[[my page]]'));
$page = query_gopher("my_page"); # all pages are normalized
like($page, qr/\[\[my page\]\]/, "Page name with space");
$page = query_gopher("my_page/menu");
like($page, qr/^0my page\tmy_page\t/m, "Space translates to underscore in links");
$page = <<EOF;
Floodgap link, and the typical Gopher link:
[http://gopher.floodgap.com/gopher/gw?a=gopher%3A%2F%2Fsdf.org%3A70%2F0%2Fusers%2Fsolderpunk%2Fphlog%2Fintroducing-vf1.txt VF-1], [gopher://sdf.org:70/1/phlogs/ Phlogs]
Solderpunk was writing about Gopher and the Web again.
[gopher://zaibatsu.circumlunar.space:70/0/~solderpunk/phlog/protocol-pondering-intensifies.txt]
[gopher://zaibatsu.circumlunar.space:70/0/~solderpunk/phlog/protocol-pondering-intensifies-ii.txt]
[gopher://zaibatsu.circumlunar.space:70/0/~solderpunk/phlog/protocol-pondering-intensifies-iii.txt]
So that's what I did. I wrote a little server that serves text files.
Requests are simple selectors. Like Gopher. Like Finger. Remember,
[[2019-01-09 Finger is Gopher|finger is gopher]]!
I called it *Nimi Mute*, "many words."
* https://alexschroeder.ch/cgit/nimi-mute/about/
* [https://github.com/kensanata/nimi-mute Nimi Mute]
As you can see in the README, you can even use `finger` or `lynx` to
get text files from it! It's all the same. `telnet` and `nc` also
work, of course. :)
Tags: [[tag:Gopher]] [[tag:Finger]] [[tag:Perl 5]]
EOF
# gopher links
update_page('Gopher', '[http://gopher.floodgap.com/gopher/gw?a=gopher%3A%2F%2Fsdf.org%3A70%2F0%2Fusers%2Fsolderpunk%2Fphlog%2Fintroducing-vf1.txt VF-1], [gopher://sdf.org:70/1/phlogs/ Phlogs]');
update_page('Gopher', $page);
$page = query_gopher("Gopher/menu");
like($page, qr/^1Phlogs\t\/phlogs\/\tsdf\.org\t70/m, "Direct Gopher link");
like($page, qr/^0VF-1\t\/users\/solderpunk\/phlog\/introducing-vf1.txt\tsdf\.org\t70/m, "Floodgap proxy link");
# gopher tags
update_page('Gopher', 'Tags: [[tag:Gopher]] [[tag:Perl 6]]');
my $re = "^0"
. join("\t",
quotemeta("zaibatsu.circumlunar.space:70/0/~solderpunk/phlog/protocol-pondering-intensifies.txt"),
quotemeta("/~solderpunk/phlog/protocol-pondering-intensifies.txt"),
quotemeta("zaibatsu.circumlunar.space"),
"70");
like($page, qr/$re/m, "Gopher link 1");
my $re = "^0"
. join("\t",
quotemeta("zaibatsu.circumlunar.space:70/0/~solderpunk/phlog/protocol-pondering-intensifies-ii.txt"),
quotemeta("/~solderpunk/phlog/protocol-pondering-intensifies-ii.txt"),
quotemeta("zaibatsu.circumlunar.space"),
"70");
like($page, qr/$re/m, "Gopher link 2");
my $re = "^0"
. join("\t",
quotemeta("zaibatsu.circumlunar.space:70/0/~solderpunk/phlog/protocol-pondering-intensifies-iii.txt"),
quotemeta("/~solderpunk/phlog/protocol-pondering-intensifies-iii.txt"),
quotemeta("zaibatsu.circumlunar.space"),
"70");
like($page, qr/$re/m, "Gopher link 3");
my $re = "^1"
. join("\t",
quotemeta("finger is gopher"),
quotemeta("2019-01-09_Finger_is_Gopher/menu"),
"127\.0\.0\.1",
$port);
like($page, qr/$re/m, "Internal link");
my $re = "^h"
. join("\t",
quotemeta("Nimi Mute"),
quotemeta("URL:https://github.com/kensanata/nimi-mute"),
"127\.0\.0\.1",
$port);
like($page, qr/$re/m, "HTML Link");
my $re = "^h"
. join("\t",
quotemeta("https://alexschroeder.ch/cgit/nimi-mute/about/"),
quotemeta("URL:https://alexschroeder.ch/cgit/nimi-mute/about/"),
"127\.0\.0\.1",
$port);
like($page, qr/$re/m, "Bare HTML Link");
# and on the page itself, tags are rendered differently
$page = query_gopher("Gopher");
like($page, qr/#Gopher/m, "Gopher tag");
like($page, qr/#Perl_6/m, "Gopher multi-word tag");
like($page, qr/#Perl_5/m, "Gopher multi-word tag");
done_testing();

201
t/grep-filtered.t Normal file
View File

@@ -0,0 +1,201 @@
# Copyright (C) 20062020 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/>.
# These tests were copied from search.t...
require './t/test.pl';
package OddMuse;
use Test::More;
use utf8; # tests contain UTF-8 characters and it matters
add_module('grep-filtered.pl');
# Search for broken regular expressions
test_page(get_page('search=%2Btest'), 'Search for: \+test');
# Test search, make sure ordinary users don't see the replacement form
update_page('SearchAndReplace', 'This is fooz and this is barz.', '', 1);
$page = get_page('search=fooz');
test_page($page,
'<h1>Search for: fooz</h1>',
'<p class="result">1 pages found.</p>',
'This is <strong>fooz</strong> and this is barz.');
xpath_test($page, '//span[@class="result"]/a[@class="local"][@href="http://localhost/wiki.pl/SearchAndReplace"][text()="SearchAndReplace"]');
test_page_negative($page, 'Replace:');
# Search page name
$page = get_page('search=andreplace');
test_page($page,
'<h1>Search for: andreplace</h1>',
'<p class="result">1 pages found.</p>');
# FIXME: Not sure this should work... 'Search<strong>AndReplace</strong>'
xpath_test($page, '//span[@class="result"]/a[@class="local"][@href="http://localhost/wiki.pl/SearchAndReplace"][text()="SearchAndReplace"]');
# Brackets in the page name
test_page(update_page('Search (and replace)', 'Muu'),
'search=%22Search\+%5c\(and\+replace%5c\)%22');
# Make sure only admins can replace
test_page(get_page('search=foo pwd=foo'),
'Replace:');
test_page(get_page('search=foo replace=bar'),
'This operation is restricted to administrators only...');
# Preview simple replacement operation
test_page(get_page('search=fooz replace=fuuz preview=1 pwd=foo'), split('\n',<<'EOT'));
<h1>Preview: fooz &#x2192; fuuz</h1>
<p class="result">1 pages found.</p>
<div class="old"><p>&lt; This is <strong class="changes">fooz</strong> and this is barz.
<div class="new"><p>&gt; This is <strong class="changes">fuuz</strong> and this is barz.
EOT
# Verify that the change has not been made
test_page(get_page('SearchAndReplace'), 'This is fooz and this is barz.');
# Simple replace where the replacement pattern is found
test_page(get_page('search=fooz replace=fuuz pwd=foo'), split('\n',<<'EOT'));
<h1>Replaced: fooz &#x2192; fuuz</h1>
<p class="result">1 pages found.</p>
This is <strong>fuuz</strong> and this is barz.
EOT
# Verify that the change has been made
test_page(get_page('SearchAndReplace'), 'This is fuuz and this is barz.');
# Replace with empty string
test_page(get_page('search=this%20is%20 replace= pwd=foo delete=1'), split('\n',<<'EOT'));
<h1>Replaced: this is &#x2192; </h1>
<p class="result">1 pages found.</p>
fuuz and barz.
EOT
test_page(get_page('SearchAndReplace'), '<p>fuuz and barz.');
# Creating 12 pages
for my $i ('A' .. 'M') {
OpenPage("Page_$i");
Save("Page_$i", 'Something');
}
# Testing default pagination (10 pages)
$page = get_page('search=Something replace=Other preview=1 pwd=foo');
test_page($page, split('\n',<<'EOT'));
<h1>Preview: Something &#x2192; Other</h1>
<p class="result">13 pages found.</p>
<div class="old"><p>&lt; <strong class="changes">Something</strong>
<div class="new"><p>&gt; <strong class="changes">Other</strong>
EOT
test_page($page, map { "Page_$_" } ('A' .. 'J'));
test_page_negative($page, map { "Page_$_" } ('K' .. 'M'));
xpath_test($page, '//a[@class="more"][@href="http://localhost/wiki.pl?search=Something;preview=1;offset=10;num=10;replace=Other"]');
# Next page
$page = get_page('search=Something preview=1 offset=10 num=10 replace=Other pwd=foo');
test_page($page, map { "Page_$_" } ('K' .. 'M'));
# Now do the replacement
$page = get_page('search=Something replace=Other pwd=foo');
test_page($page, 'Replaced: Something &#x2192; Other', '13 pages found',
map { "Page_$_" } ('A' .. 'M'));
# Verify that the change has been made
test_page(get_page('search=Other'), 'Search for: Other', '13 pages found');
# Replace with backreferences, where the replacement pattern is no longer found.
# Take 'fuuz and barz.' and replace ([a-z]+)z with x$1 results in 'xfuu and xbar.'
test_page(get_page('"search=([a-z]%2b)z" replace=x%241 pwd=foo'), '1 pages found');
test_page(get_page('SearchAndReplace'), 'xfuu and xbar.');
# Create an extra page that should not be found
update_page('NegativeSearchTest', 'this page contains an ab');
update_page('NegativeSearchTestTwo', 'this page contains another ab');
test_page(get_page('search=xb replace=[xa]b pwd=foo'), '1 pages found'); # not two ab!
test_page(get_page('SearchAndReplace'), 'xfuu and \[xa\]bar.');
# Handle quoting
test_page(get_page('search=xfuu replace=/fuu/ pwd=foo'), '1 pages found'); # not two ab!
test_page(get_page('SearchAndReplace'), '/fuu/ and \[xa\]bar.');
test_page(get_page('search=/fuu/ replace={{fuu}} pwd=foo'), '1 pages found');
test_page(get_page('SearchAndReplace'), '\{\{fuu\}\} and \[xa\]bar.');
# Check headers especially the quoting of non-ASCII characters.
$page = update_page("Alexander_Schröder", "Edit [[Alexander Schröder]]!");
xpath_test($page,
'//h1/a[@title="Click to search for references to this page"][@href="http://localhost/wiki.pl?search=%22Alexander+Schr%c3%b6der%22"][text()="Alexander Schröder" or text()="' . Encode::encode_utf8('Alexander Schröder') . '"]',
'//a[@class="local"][@href="http://localhost/wiki.pl/Alexander_Schr%c3%b6der"][text()="Alexander Schröder" or text()="' . Encode::encode_utf8('Alexander Schröder') . '"]');
xpath_test(update_page('IncludeSearch',
"first line\n<search \"ab\">\nlast line"),
'//p[text()="first line "]', # note the NL -> SPC
'//div[@class="search"]/p/span[@class="result"]/a[@class="local"][@href="http://localhost/wiki.pl/NegativeSearchTest"][text()="NegativeSearchTest"]',
'//div[@class="search"]/p/span[@class="result"]/a[@class="local"][@href="http://localhost/wiki.pl/NegativeSearchTestTwo"][text()="NegativeSearchTestTwo"]',
'//p[text()=" last line"]'); # note the NL -> SPC
xpath_test(get_page('search=Schröder'),
'//input[@name="search"][@value="Schröder"]');
# Search for zero
update_page("Zero", "This is about 0 and the empty string ''.");
test_page(get_page('search=0'),
'<h1>Search for: 0</h1>',
'<p class="result">1 pages found.</p>',
"This is about <strong>0</strong> and the empty string ''.",
'meta name="robots" content="NOINDEX,FOLLOW"');
# Search for tags
update_page("Tag", "This is <b>bold</b>.");
test_page(get_page('search="<b>"'),
'<h1>Search for: &lt;b&gt;</h1>',
'<p class="result">1 pages found.</p>',
"This is <strong>&lt;b&gt;</strong>.");
# Search for quoted strings
update_page("Tugend", "Ein wirklich tugendhafter Mensch
bemüht sich nicht um seine Tugend,
darum ist er tugendhaft.");
update_page("Laster", "Ein scheinbar tugendhafter Mensch
bemüht sich dauernd um seine Tugend,
darum ist er nicht wirklich tugendhaft.");
# unordered words
test_page(get_page('search="darum ist er tugendhaft" raw=1'),
'title: Tugend', 'title: Laster');
# in order
$page = get_page('search="\"darum ist er tugendhaft\"" raw=1');
test_page($page, 'title: Tugend');
test_page_negative($page, 'title: Laster');
done_testing;

14
t/hr.t
View File

@@ -27,18 +27,18 @@ test_page(get_page('hr'), 'one ---- two');
add_module('usemod.pl');
update_page('hr', "one\n----\nthree\n");
test_page(get_page('hr'),
'<div class="content browse"><p>one </p><hr /><p>three</p></div>');
'<div class="content browse" lang="en"><p>one </p><hr /><p>three</p></div>');
remove_rule(\&UsemodRule);
# headers only
add_module('headers.pl');
update_page('hr', "one\n----\ntwo\n");
test_page(get_page('hr'),
'<div class="content browse"><h3>one</h3><p>two</p></div>');
'<div class="content browse" lang="en"><h3>one</h3><p>two</p></div>');
update_page('hr', "one\n\n----\nthree\n");
test_page(get_page('hr'),
'<div class="content browse"><p>one</p><hr /><p>three</p></div>');
'<div class="content browse" lang="en"><p>one</p><hr /><p>three</p></div>');
remove_rule(\&HeadersRule);
# with portrait support
@@ -49,19 +49,19 @@ clear_pages();
add_module('portrait-support.pl');
update_page('hr', "[new]one\n----\ntwo\n");
test_page(get_page('hr'),
'<div class="content browse"><div class="color one level0"><p>one </p></div><hr /><p>two</p></div>');
'<div class="content browse" lang="en"><div class="color one level0"><p>one </p></div><hr /><p>two</p></div>');
# usemod and portrait-support
add_module('usemod.pl');
update_page('hr', "one\n----\nthree\n");
test_page(get_page('hr'),
'<div class="content browse"><p>one </p><hr /><p>three</p></div>');
'<div class="content browse" lang="en"><p>one </p><hr /><p>three</p></div>');
remove_rule(\&UsemodRule);
# headers and portrait-support
add_module('headers.pl');
update_page('hr', "one\n----\ntwo\n");
test_page(get_page('hr'), '<div class="content browse"><h3>one</h3><p>two</p></div>');
test_page(get_page('hr'), '<div class="content browse" lang="en"><h3>one</h3><p>two</p></div>');
update_page('hr', "one\n\n----\nthree\n");
test_page(get_page('hr'), '<div class="content browse"><p>one</p><hr /><p>three</p></div>');
test_page(get_page('hr'), '<div class="content browse" lang="en"><p>one</p><hr /><p>three</p></div>');

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2008-2018 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2008-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
@@ -15,7 +15,7 @@
require './t/test.pl';
package OddMuse;
use Test::More tests => 43;
use Test::More tests => 45;
add_module('journal-rss.pl');
@@ -110,6 +110,10 @@ xpath_test(get_page('action=journal offset=10'),
# check next page but with a tag search
xpath_test(get_page('action=journal search=tag:oddmuse'),
'//atom:link[@rel="self"][@href="http://localhost/wiki.pl?action=journal;search=tag:oddmuse"]',
'//atom:link[@rel="last"][@href="http://localhost/wiki.pl?action=journal;search=tag:oddmuse"]',
'//atom:link[@rel="previous"][@href="http://localhost/wiki.pl?action=journal;offset=10;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

@@ -1,4 +1,4 @@
# Copyright (C) 2006 Alex Schroeder <alex@emacswiki.org>
# Copyright (C) 2006-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,15 +15,38 @@
require './t/test.pl';
package OddMuse;
use Test::More tests => 5;
use Test::More;
use utf8; # tests contain UTF-8 characters and it matters
%Languages = ('de' => '\b(der|die|das|und|oder)\b',
'fr' => '\b(et|le|la|pas)\b', );
'fr' => '\b(et|le|la|ne|pas)\b', );
is(GetLanguages('This is English text and cannot be identified.'), '', 'unknown language');
is(GetLanguages('Die Katze tritt die Treppe krumm.'), '', 'not enough German words');
is(GetLanguages('Die Katze tritt die Treppe und die Stiege krumm.'), 'de', 'enough German words');
is(GetLanguages('Le chat fait la même chose et ne chante pas.'), 'fr', 'enough French words');
is(GetLanguages('Die Katze tritt die Treppe und die Stiege krumm. '
. 'Le chat fait la même chose et ne chante pas.'), 'de,fr', 'both German and French');
is(GetLanguages('Die Katze tritt die Treppe und die Stiege krumm. ' # 4 matches
. 'Le chat fait la même chose et ne chante pas.' # 5 matches
), 'fr,de', 'both German and French');
is(GetLanguage('This is English text and cannot be identified.'), 'en', 'now it defaults to English');
is(GetLanguage('Die Katze tritt die Treppe krumm.'), 'en', 'not enough German words but it defaults to English');
is(GetLanguage('Die Katze tritt die Treppe krumm und so.'), 'de', 'three German words');
is(GetLanguage('Die Katze tritt die Treppe und die Stiege krumm. ' # 4 matches
. 'Le chat fait la même chose et ne chante pas.' # 5 matches
), 'fr', 'French has the most hits');
my $id = 'Test';
my $text = 'Die Katze tritt die Treppe und die Stiege krumm. ' # 4 matches
. 'Le chat fait la même chose et ne chante pas.'; # 5 matches
AppendStringToFile($ConfigFile,<<'EOT');
%Languages = ('de' => '\b(der|die|das|und|oder)\b',
'fr' => '\b(et|le|la|ne|pas)\b', );
EOT
test_page(update_page($id, $text), /Die Katze/);
test_page(ReadFileOrDie($RcFile), /\bfr,de\b/);
test_page(get_page($id), /lang="fr"/);
done_testing;

View File

@@ -1,5 +1,5 @@
#!/usr/bin/env perl
# Copyright (C) 20142017 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
@@ -16,7 +16,7 @@
require './t/test.pl';
package OddMuse;
use Test::More tests => 53;
use Test::More tests => 68;
add_module('markdown-rule.pl');
add_module('bbcode.pl');
@@ -99,6 +99,8 @@ foo\n=\nbar
<h2>foo ##</h2>
bar\n##foo\nbar
bar <h2>foo</h2><p>bar</p>
this is #foo tag
this is #foo tag
```\nfoo\n```\nbar
<pre>foo</pre><p>bar</p>
```\nfoo\n```
@@ -107,6 +109,10 @@ bar <h2>foo</h2><p>bar</p>
``` foo ``` bar
`bar`
<code>bar</code>
"""\n*foo*\n"""\nhallo
<blockquote><p><em>foo</em></p></blockquote><p>hallo</p>
> *foo*\nhallo
<blockquote><p><em>foo</em></p></blockquote><p>hallo</p>
|a|b|\n|c|d|\nbar
<table><tr><th>a</th><th>b</th></tr><tr><td>c</td><td>d</td></tr></table><p>bar</p>
|a|b|\n|c|d|
@@ -119,17 +125,52 @@ bar <h2>foo</h2><p>bar</p>
<table><tr><th><em>foo</em></th></tr></table>
|_foo_
<table><tr><th><em style="font-style: normal; text-decoration: underline">foo</em></th></tr></table>
| a| b|\n| c| d|
<table><tr><th style="text-align: right">a</th><th style="text-align: right">b</th></tr><tr><td style="text-align: right">c</td><td style="text-align: right">d</td></tr></table>
| a | b |\n| c | d |
<table><tr><th style="text-align: center">a</th><th style="text-align: center">b</th></tr><tr><td style="text-align: center">c</td><td style="text-align: center">d</td></tr></table>
foo ~~bar~~
foo <del>bar</del>
pay 1.-/month
pay 1.-/month
EOT
xpath_run_tests(split('\n',<<'EOT'));
xpath_run_tests(split(/\n/,<<'EOT'));
[example](http://example.com/)
//a[@class="url http"][@href="http://example.com/"][text()="example"]
//a[@class="url"][@href="http://example.com/"][text()="example"]
[an example](http://example.com/)
//a[@class="url http"][@href="http://example.com/"][text()="an example"]
//a[@class="url"][@href="http://example.com/"][text()="an example"]
[an example](http://example.com/ "Title")
//a[@class="url http"][@href="http://example.com/"][@title="Title"][text()="an example"]
//a[@class="url"][@href="http://example.com/"][@title="Title"][text()="an example"]
[an\nexample](http://example.com/)
//a[@class="url"][@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
# test the quote again, writing an actual page
test_page(update_page('cache', qq{"""\n*foo*\n"""\nhallo}),
'<blockquote><p><em>foo</em></p></blockquote><p>hallo</p>');
# test the page again to find errors in dirty block marking
test_page(get_page('cache'),
'<blockquote><p><em>foo</em></p></blockquote><p>hallo</p>');
# test the other quote again, writing an actual page
test_page(update_page('cache', qq{> *foo*\n> bar\nhallo}),
'<blockquote><p><em>foo</em> bar</p></blockquote><p>hallo</p>');
# test the page again to find errors in dirty block marking
test_page(get_page('cache'),
'<blockquote><p><em>foo</em> bar</p></blockquote><p>hallo</p>');
@MyRules = grep { $_ ne \&MarkdownExtraRule } @MyRules;
run_tests(split(/\n/,<<'EOT'));
__underline__
__underline__
_underline_
_underline_
//italic//
//italic//
/italic/
/italic/
EOT

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2015-2016 Alex Schroeder <alex@gnu.com>
# Copyright (C) 2015-2019 Alex Schroeder <alex@gnu.com>
# Copyright (C) 2015 Alex Jakimenko <alex.jakimenko@gmail.com>
#
# This program is free software: you can redistribute it and/or modify it under

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2016 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2016-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

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2016 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2016-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

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20062016 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20062019 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
@@ -14,7 +14,7 @@
require './t/test.pl';
package OddMuse;
use Test::More tests => 78;
use Test::More tests => 89;
use utf8; # tests contain UTF-8 characters and it matters
add_module('namespaces.pl');
@@ -188,3 +188,28 @@ $feed = get_page('action=rc raw=1');
test_page($feed, 'title: Wiki', 'title: Muu:Test');
# BackHome never existed and Muu:BackHome was rolled back
test_page_negative($feed, 'title: Muu:BackHome', 'title: BackHome');
AppendStringToFile($ConfigFile, <<'EOT');
$InterSitePattern = '[\p{Uppercase}\d][\w_ ]*';
$InterLinkPattern = "($InterSitePattern:[-a-zA-Z0-9\x{0080}-\x{fffd}_=!?#\$\@~`\%&*+\\/:;.,]*[-a-zA-Z0-9\x{0080}-\x{fffd}_=#\$\@~`\%&*+\\/])$QDelim";
$FreeInterLinkPattern = "($InterSitePattern:[-a-zA-Z0-9\x{0080}-\x{fffd}_=!?#\$\@~`\%&*+\\/:;.,()' ]+)";
EOT
test_page(update_page('Bond', 'My name is Bond', '007 ns', undef, undef,
'ns=007', 'username=James'),
'<title>Wiki 007: Bond</title>',
'<p>My name is Bond</p>');
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,
'//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"]');
'//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"]');
# verify cookie
test_page($page, 'Set-Cookie: Wiki=trail%251eFirstPage');

View File

@@ -34,7 +34,7 @@ test_page(get_page('headers'), '<div class="color one level0"><p>foo </p></div><
add_module('toc.pl');
test_page(update_page('headers', "[new]foo\n== one ==\ntext\n== two ==\ntext\n== three ==\ntext\n"),
# default to before the header
'<div class="content browse"><div class="color one level0"><p>foo </p></div>',
'<div class="content browse" lang="en"><div class="color one level0"><p>foo </p></div>',
'<div class="toc"><h2>Contents</h2><ol>',
qq{<li><a href="#${TocAnchorPrefix}1">one</a></li>},
qq{<li><a href="#${TocAnchorPrefix}2">two</a></li>},

26
t/post-instead-of-get.t Normal file
View File

@@ -0,0 +1,26 @@
# Copyright (C) 2025 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 => 6;
add_module('nosearch.pl');
add_module('post-instead-of-get.pl');
like(get_page('HomePage'), qr/<h1>HomePage<\/h1>/, "no link in the title");
my $page = get_page('RecentChanges');
for my $day (@RcDays) {
like($page, qr/$day/, "$day days found");
}

View File

@@ -14,7 +14,7 @@
require './t/test.pl';
package OddMuse;
use Test::More tests => 2;
use Test::More tests => 3;
add_module('pygmentize.pl');
@@ -23,9 +23,14 @@ add_module('pygmentize.pl');
skip "pygmentize not found", 2;
}
my $text = '{{{perl\nmy $x = "hello";\n}}}\n';
$page = apply_rules(newlines($text));
test_page($page,
'<span style="color: #666666">=</span>');
$ENV{PATH} = '.'; # pygmentize is not installed in the current directory
$page = apply_rules(newlines('{{{\ntest\n}}}\n'));
$page = apply_rules(newlines($text));
test_page($page,
'\bsh\b.*\bpygmentize\b.*\bnot found\b',
'<pre>test</pre>');
'<pre>my \$x = "hello";</pre>');
}

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

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20132015 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20132019 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

58
t/rollback-hang.t Normal file
View File

@@ -0,0 +1,58 @@
# 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 from=1691499900'); # need from or the result is empty
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 from=1691499900'); # need from or the result is empty
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;p&gt;foo foo&lt;/p&gt;</description>');
'<description>&lt;div class="e-content" 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

@@ -1,4 +1,4 @@
# Copyright (C) 2006-2018 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2006-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
@@ -184,9 +184,9 @@ test_page_negative($page, qw(Alex Jeff));
# check the tag cloud
xpath_test(get_page('action=tagcloud'),
'//h1[text()="Tag Cloud"]',
'//a[@style="font-size: 200%;"][@href="http://localhost/wiki.pl?search=tag:podcast"][@title="3"][text()="podcast"]',
'//a[@style="font-size: 80%;"][@href="http://localhost/wiki.pl?search=tag:old_school"][@title="1"][text()="old school"]',
'//a[@style="font-size: 80%;"][@href="http://localhost/wiki.pl?search=tag:mag"][@title="1"][text()="mag"]');
'//a[@href="http://localhost/wiki.pl?search=tag:podcast"][text()="podcast"]',
'//a[@href="http://localhost/wiki.pl?search=tag:old_school"][text()="old school"]',
'//a[@href="http://localhost/wiki.pl?search=tag:mag"][text()="mag"]');
# check interference; in order for this test to work, we need to make
# sure that localnames is loaded first

View File

@@ -1,4 +1,4 @@
# Copyright (C) 20042015 Alex Schroeder <alex@gnu.org>
# Copyright (C) 20042019 Alex Schroeder <alex@gnu.org>
# Copyright (C) 2015 Alex-Daniel Jakimenko <alex.jakimenko@gmail.com>
#
# This program is free software; you can redistribute it and/or modify it under
@@ -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} = $ENV{PERLBREW_PATH} . ':' . $ENV{PATH};
$ENV{PATH} = join(':', split(/ /, $ENV{PERLBREW_PATH}), $ENV{PATH});
} elsif (-f '/usr/local/bin/perl') {
$ENV{PATH} = '/usr/local/bin:' . $ENV{PATH};
}
@@ -197,16 +197,24 @@ sub test_page_negative {
sub xpath_do {
my ($check, $message, $page, @tests) = @_;
$page =~ s/^.*?(<html)/$1/s; # strip headers
$page =~ s/^.*?<\?xml.*?>\s*//s; # strip xml processing
$page =~ s/^(.+\r\n)*\r\n//; # strip headers
my $xml = $page =~ s/^.*?<\?xml.*?>\s*//s; # strip xml processing
my $page_shown = 0;
my $parser = XML::LibXML->new();
my $parser = XML::LibXML->new(recover => 1, suppress_errors => 1); # allow HTML5 tags
my $doc;
my @result;
SKIP: {
eval { $doc = $parser->parse_html_string($page) };
eval { $doc = $parser->parse_string($page) } if $@;
skip("Cannot parse ".name($page).": $@", $#tests + 1) if $@;
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";
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, '//div[@class="footer"]/span[@class="translation bar"]/a[@class="translation de"][@href="http://localhost/wiki.pl/HauptSeite"][text()="Deutsch"]');
xpath_test($page, '//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]]'),
'//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"]');
'//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]]'),
'//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"]');
'//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 on this page');
'Regular expression "spam" matched "Spam" 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 on this page');
'Regular expression "spam" matched "Spam" on this page');

View File

@@ -1,4 +1,4 @@
# Copyright (C) 2017 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

103
t/webmention.t Normal file
View File

@@ -0,0 +1,103 @@
# 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
# 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 => 21;
use LWP::UserAgent;
use XML::LibXML;
add_module('webmention.pl');
AppendStringToFile($ConfigFile, <<'EOT');
$CommentsPrefix = 'Comments_on_';
$FooterNote = '<p>Author: <a rel="author" href="https://alexschroeder.ch/">Alex Schroeder</a></p>';
EOT
$CommentsPrefix = 'Comments_on_';
like(get_page(''), qr/webmention/,
"Webmention link for default URL");
like(get_page('HomePage'), qr/webmention/,
"Webmention link for homepage");
unlike(get_page('Comments_on_HomePage'), qr/webmention/,
"No webmention link for comment pages");
unlike(get_page('action=history id=HomePage'), qr/webmention/,
"No webmention link for history action");
unlike(get_page('action=browse id=HomePage revision=1'), qr/webmention/,
"No webmention link for browse action with revision");
$UsePathInfo = 1;
# This test is is going to use two servers in addition to this script, but in
# actual fact we are all going to share the data directory.
test_page(update_page('Target', 'This is the test page.'), 'This is the test page');
# Server 1 is going to be the webmention server.
start_server();
# Check whether the child is up and running
my $ua = LWP::UserAgent->new;
my $response = $ua->get("$ScriptName?action=version");
ok($response->is_success, "There is a wiki running at $ScriptName");
like($response->decoded_content, qr/\bwebmention\.pl/, "The server has the webmention extension installed");
# Now that we have the webmention server running, we need to get the URL of the
# test page, including its port.
my $target_url = ScriptUrl('Target');
# Verify that the target exists via external request
$response = $ua->get($target_url);
ok($response->is_success, "Target URL response");
like($response->decoded_content, qr/This is the test page/, "Target URL decoded");
# Create the Source page before starting the next server (so that it knows about
# the new page)
test_page(update_page('Source', "Link to $target_url"), 'Link to');
# Server 2 is going to be the source server.
start_server(2);
# Check whether the child is up and running (with a new $ScriptName!)
$response = $ua->get("$ScriptName?action=version");
ok($response->is_success, "There is a wiki running at $ScriptName");
# New script name means we can now get the source_url.
my $source_url = ScriptUrl('Source');
# Verify that the source exists via external request
$response = $ua->get($source_url);
ok($response->is_success, "Source URL response");
like($response->decoded_content, qr/Link to/, "Source URL decoded");
like($response->decoded_content, qr/$target_url/, "Source page links to Target page");
# Find the Webmention URL
$response = $ua->get($target_url);
ok($response->is_success, "Target URL response");
like($response->decoded_content, qr/rel="webmention"/, "Target page has webmention link");
# Parse target page
my $parser = XML::LibXML->new(recover => 2);
my $dom = $parser->load_html(string => $response->decoded_content);
my $webmention = $dom->findvalue('//link[@rel="webmention"]/@href');
$response = $ua->post($webmention, { source => $source_url, target => $target_url });
ok($response->is_success, 'Got webmention response: ' . $response->message);
$page = get_page('Comments_on_Target');
test_page($page, 'Webmention:', $source_url);
xpath_test($page, '//a[@class="url https outside"][@href="https://alexschroeder.ch/"][text()="Alex Schroeder"]');

207
wiki.pl Normal file → Executable file
View File

@@ -1,5 +1,5 @@
#! /usr/bin/perl
# Copyright (C) 2001-2019
#! /usr/bin/env perl
# Copyright (C) 2001-2023
# Alex Schroeder <alex@gnu.org>
# Copyright (C) 2014-2015
# Alex Jakimenko <alex.jakimenko@gmail.com>
@@ -157,12 +157,11 @@ our $CommentsPrefix = ''; # prefix for comment pages, eg. 'Comments_on
our $CommentsPattern = undef; # regex used to match comment pages
our $HtmlHeaders = ''; # Additional stuff to put in the HTML <head> section
our $IndentLimit = 20; # Maximum depth of nested lists
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 = 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">);
$DocumentHeader = "<!DOCTYPE html>\n<html>";
our @MyFooters = (\&GetCommentForm, \&WrapperEnd, \&DefaultFooter);
# Checkboxes at the end of the index.
our @IndexOptions = ();
@@ -209,7 +208,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;
@@ -386,13 +385,13 @@ sub InitLinkPatterns {
$InterSitePattern = '[A-Z\x{0080}-\x{fffd}]+[A-Za-z\x{0080}-\x{fffd}]+';
$InterLinkPattern = "($InterSitePattern:[-a-zA-Z0-9\x{0080}-\x{fffd}_=!?#\$\@~`\%&*+\\/:;.,]*[-a-zA-Z0-9\x{0080}-\x{fffd}_=#\$\@~`\%&*+\\/])$QDelim";
$FreeInterLinkPattern = "($InterSitePattern:[-a-zA-Z0-9\x{0080}-\x{fffd}_=!?#\$\@~`\%&*+\\/:;.,()' ]+)"; # plus space and other characters, and no restrictions on the end of the pattern
$UrlProtocols = 'http|https|ftp|afs|news|nntp|mid|cid|mailto|wais|prospero|telnet|gopher|irc|feed';
$UrlProtocols = 'https?|ftp|afs|news|nntp|mid|cid|mailto|wais|prospero|telnet|gophers?|irc|feed';
$UrlProtocols .= '|file' if $NetworkFile;
my $UrlChars = '[-a-zA-Z0-9/@=+$_~*.,;:?!\'"()&#%]'; # see RFC 2396
my $EndChars = '[-a-zA-Z0-9/@=+$_~*]'; # no punctuation at the end of the url.
$UrlPattern = "((?:$UrlProtocols):$UrlChars+$EndChars)";
$FullUrlPattern="((?:$UrlProtocols):$UrlChars+)"; # when used in square brackets
$ImageExtensions = '(gif|jpg|jpeg|png|bmp|svg)';
$ImageExtensions = '(gif|jpg|jpeg|png|bmp|svg|webp)';
}
sub Clean {
@@ -449,7 +448,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 +514,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\s+/cg) {
} elsif (m/\G[ \t\r\n]+/cg) { # don't use \s because we want to honor NO-BREAK SPACE etc
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 +664,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/^\s*[[:alpha:]]@@+\s*=\s*('|").+\1/;
if $html_tag_attr and $html_tag_attr !~ m/=/;
splice(@HtmlAttrStack, 0, @HtmlAttrStack - @HtmlStack); # truncate to size of @HtmlStack
foreach ($found .. $depth - 1) {
unshift(@HtmlStack, $html_tag);
@@ -801,7 +800,7 @@ sub UrlEncode {
sub UrlDecode {
my $str = shift;
return decode_utf8($str) if $str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eg;
return decode_utf8($str) if $str =~ s/%([0-9a-f][0-9a-f])/chr(hex($1))/eig;
return $str;
}
@@ -876,16 +875,13 @@ 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 $q->start_div({-class=>'page h-entry'}),
$q->h1({-class => 'entry-title'},
$links ? GetPageLink($id) : $q->a({-name=>$id}, UrlEncode(FreeToNormal($id))));
print '<article class="h-entry">', $q->h1({-class => 'p-name'},
$links ? GetPageLink($id) : $q->a({-name=>$id}, UrlEncode(FreeToNormal($id))));
if ($variation ne 'titles') {
print $q->start_div({-class=>'entry-content'});
PrintPageHtml();
print $q->end_div();
PrintPageCommentsLink($id, $comments);
}
print $q->end_div();
print '</article>';
$n++; # pages actually printed
}
return $i;
@@ -1133,7 +1129,7 @@ sub GetUrl {
}
$url = UnquoteHtml($url); # links should be unquoted again
if ($images and $url =~ /^(http:|https:|ftp:).+\.$ImageExtensions$/i) {
return $q->img({-src=>$url, -alt=>$url, -class=>$class});
return $q->img({-src=>$url, -alt=>$url, -class=>$class, -loading=>'lazy'});
} else {
return $q->a({-href=>$url, -class=>$class}, $text);
}
@@ -1222,7 +1218,8 @@ sub GetDownloadLink {
if ($image) {
$action = $ScriptName . (($UsePathInfo and not $revision) ? '/' : '?') . $action;
return $action if $image == 2;
my $result = $q->img({-src=>$action, -alt=>UnquoteHtml($alt), -title=>UnquoteHtml($alt), -class=>'upload'});
my $result = $q->img({-src=>$action, -alt=>UnquoteHtml($alt), -title=>UnquoteHtml($alt),
-class=>'upload', -loading=>'lazy'});
$result = ScriptLink(UrlEncode($id), $result, 'image') unless $id eq $OpenPageName;
return $result;
} else {
@@ -1244,12 +1241,15 @@ sub PrintCache { # Use after OpenPage!
}
sub PrintPageHtml { # print an open page
return unless GetParam('page', 1);
return unless GetParam('page', 1) and $Page{text};
my $lang = (split /,/, $Page{languages})[0] || $CurrentLanguage;
print qq{<div class="e-content" lang="$lang">};
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
@@ -1276,7 +1276,8 @@ sub PageHtml {
OpenPage($id);
my $diff = ToString \&PrintPageDiff;
return $error if $limit and length($diff) > $limit;
my $page = ToString \&PrintPageHtml;
my $lang = (split /,/, $Page{languages})[0] // $CurrentLanguage;
my $page .= ToString \&PrintPageHtml;
return $diff . $q->p($error) if $limit and length($diff . $page) > $limit;
return $diff . $page;
}
@@ -1312,7 +1313,7 @@ sub GetId {
SetParam($p, 1); # script/p/q -> p=1
}
}
return $id;
return FreeToNormal($id);
}
sub DoBrowseRequest {
@@ -1542,28 +1543,34 @@ sub LatestChanges {
sub StripRollbacks {
my @result = @_;
if (not (GetParam('all', $ShowAll) or GetParam('rollback', $ShowRollbacks))) { # strip rollbacks
my (%rollback);
my (%rollback); # used for single-page rollbacks
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) {
$rollback{$target_id} = $target_ts; # single page rollback
splice(@result, $i, 1); # strip marker
# 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);
} 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;
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
$i-- while $i > 0 and $target_ts < $result[$i-1][0];
# splice the lines found
splice(@result, $i, $end - $i + 1);
}
} elsif ($rollback{$id} and $ts > $rollback{$id}) {
splice(@result, $i, 1); # strip rolled back single pages
}
}
} else { # just strip the marker left by DoRollback()
} else { # if rollbacks are not not shown, just strip the markers
for (my $i = $#result; $i >= 0; $i--) {
splice(@result, $i, 1) if $result[$i][1] eq '[[rollback]]'; # id
}
@@ -1706,11 +1713,16 @@ sub RcOtherParameters {
my $more = '';
foreach (@_, qw(page diff full all showedit rollback rcidonly rcuseronly rchostonly rcclusteronly rcfilteronly match lang followup)) {
my $val = GetParam($_, '');
$more .= ";$_=$val" if $val;
$more .= ";$_=" . UrlEncode($val) if $val;
}
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));
@@ -1856,7 +1868,7 @@ sub RcTextRevision {
$summary = GetPageContent($id) if GetParam('full', 0);
print "\n", RcTextItem('title', NormalToFree($id)),
RcTextItem('description', $summary),
RcTextItem('generator', GetAuthor($username)),
RcTextItem('generator', GetAuthor($username, $host)),
RcTextItem('language', join(', ', @{$languages})), RcTextItem('link', $link),
RcTextItem('last-modified', TimeToW3($ts)),
RcTextItem('revision', $revision),
@@ -1873,11 +1885,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
$excluded{$1} = 1;
push(@excluded, $1);
}
}
}
@@ -1897,7 +1909,7 @@ sub GetRcRss {
};
my $title = QuoteHtml($SiteName) . ': ' . GetParam('title', QuoteHtml(NormalToFree($HomePage)));
$rss .= "<title>$title</title>\n";
$rss .= "<link>" . ScriptUrl($HomePage) . "</link>\n";
$rss .= "<link>$ScriptName?" . RcSelfWebsite() . "</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};
@@ -1917,14 +1929,14 @@ sub GetRcRss {
$rss .= "<image>\n";
$rss .= "<url>$RssImageUrl</url>\n";
$rss .= "<title>$title</title>\n"; # the same as the channel
$rss .= "<link>$ScriptName</link>\n"; # the same as the channel
$rss .= "<link>$ScriptName?" . RcSelfWebsite() . "</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 $excluded{$id} or ($limit ne 'all' and $count++ >= $limit);
return if grep { $id =~ /$_/ } @excluded or ($limit ne 'all' and $count++ >= $limit);
$rss .= "\n" . RssItem($id, @_);
});
$rss .= "</channel>\n</rss>\n";
@@ -2212,11 +2224,16 @@ sub ScriptLinkDiff {
return ScriptLink($action, $text, 'diff');
}
sub ColorCode {
sub Code {
my ($str) = @_;
my $num = unpack("L",B::hash($str)); # 32-bit integer
my $code = sprintf("%o", $num); # octal is 0-7
my @indexes = split(//, substr($code, 0, 4)); # four numbers
return substr($code, 0, 4); # four numbers
}
sub ColorCode {
my $code = Code(@_);
my @indexes = split(//, $code); # four numbers
my @colors = qw/red orange yellow green blue indigo violet white/;
return $q->span({-class => 'ip-code', -title => T('Anonymous')},
join('', map { $q->span({-class => $colors[$_]}, $_) }
@@ -2224,9 +2241,10 @@ sub ColorCode {
}
sub GetAuthor {
my ($username) = @_;
my ($username, $host) = @_;
return $username if $username;
return T('Anonymous');
return T('Anonymous') if $host eq 'Anonymous';
return Code($host);
}
sub GetAuthorLink {
@@ -2275,12 +2293,12 @@ sub GetHeader {
sub GetHeaderDiv {
my ($id, $title, $oldId, $embed) = @_;
my $result .= $q->start_div({-class=>'header'});
my $result .= '<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 .= $q->start_div({-class=>'menu'});
$result .= '<nav>';
if (GetParam('toplinkbar', $TopLinkBar) != 2) {
$result .= GetGotoBar($id);
if (%SpecialDays) {
@@ -2292,10 +2310,10 @@ sub GetHeaderDiv {
}
}
$result .= GetSearchForm() if GetParam('topsearchform', $TopSearchForm) != 2;
$result .= $q->end_div();
$result .= '</nav>';
$result .= $q->div({-class=>'message'}, $Message) if $Message;
$result .= GetHeaderTitle($id, $title, $oldId);
$result .= $q->end_div();
$result .= '</header>';
return $result;
}
@@ -2361,15 +2379,14 @@ sub Cookie {
sub GetHtmlHeader { # always HTML!
my ($title, $id) = @_;
my $edit_link = '';
$edit_link = '<link rel="alternate" type="application/wiki" title="'
. T('Edit this page') . '" href="'
. ScriptUrl('action=edit;id=' . UrlEncode($id)) . '" />' if $id;
my $edit_link = $id ? '<link rel="alternate" type="application/wiki" title="'
. T('Edit this page') . '" href="' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . '" />' : '';
my $theme = GetParam('theme', 'default');
return $DocumentHeader
. $q->head($q->title($title) . $edit_link
. GetCss() . GetRobots() . GetFeeds() . $HtmlHeaders
. '<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />')
. '<body class="' . GetParam('theme', 'default') . '">';
. qq{<body class="$theme" lang="$CurrentLanguage">};
}
sub GetRobots { # NOINDEX for non-browse pages.
@@ -2407,7 +2424,8 @@ sub GetCss { # prevent javascript injection
sub PrintPageContent {
my ($text, $revision, $comment) = @_;
print $q->start_div({-class=>'content browse'});
print $q->start_div({-class=>'content browse', -lang=>GetLanguage($text)});
# This is a lot like PrintPageHtml except that it also works for older revisions
if ($revision eq '' and $Page{blocks} and GetParam('cache', $UseCache) > 0) {
PrintCache();
} else {
@@ -2443,7 +2461,7 @@ sub WrapperEnd { # called via @MyFooters
sub DefaultFooter { # called via @MyFooters
my ($id, $rev, $comment, $page) = @_;
my $html = $q->start_div({-class=>'footer'}) . $q->hr();
my $html = $q->hr();
$html .= GetGotoBar($id) if GetParam('toplinkbar', $TopLinkBar) != 1;
$html .= GetFooterLinks($id, $rev);
$html .= GetFooterTimestamp($id, $rev, $page);
@@ -2454,8 +2472,7 @@ sub DefaultFooter { # called via @MyFooters
}
$html .= T($FooterNote) if $FooterNote;
$html .= $q->p(Ts('%s seconds', (time - $Now))) if GetParam('timing', 0);
$html .= $q->end_div();
return $html;
return "<footer>$html</footer>";
}
sub GetFooterTimestamp {
@@ -2546,31 +2563,37 @@ sub GetFormStart {
}
sub GetSearchForm {
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'));
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')) . ' ';
}
if (GetParam('matchingpages', $MatchingPages)) {
$html .= $q->label({-for=>'matchingpage'}, T('Filter:')) . ' '
. $q->textfield(-name=>'match', -id=>'matchingpage', -size=>15) . ' ';
$html .= $q->span({-class=>'match'},
$q->label({-for=>'matchingpage'}, T('Filter:')) . ' '
. $q->textfield(-name=>'match', -id=>'matchingpage', -size=>15)) . ' ';
}
if (%Languages) {
$html .= $q->label({-for=>'searchlang'}, T('Language:')) . ' '
. $q->textfield(-name=>'lang', -id=>'searchlang', -size=>5, -default=>GetParam('lang', '')) . ' ';
$html .= $q->span({-class=>'lang'},
$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
@@ -3351,7 +3374,7 @@ sub SortIndex {
sub DoIndex {
my $raw = GetParam('raw', 0);
my $match = GetParam('match', '');
my $limit = GetParam('n', '');
my @pages = ();
my @menu = ($q->label({-for=>'indexmatch'}, T('Filter:')) . ' '
. $q->textfield(-name=>'match', -id=>'indexmatch', -size=>20));
@@ -3362,8 +3385,9 @@ sub DoIndex {
push(@pages, $sub->()) if $value;
push(@menu, $q->checkbox(-name=>$option, -checked=>$value, -label=>$text));
}
@pages = grep /$match/i, @pages if $match;
@pages = Matched(GetParam('match', ''), @pages);
@pages = sort SortIndex @pages;
@pages = @pages[0 .. $limit - 1] if $limit;
if ($raw) {
print GetHttpHeader('text/plain'); # and ignore @menu
} else {
@@ -3534,11 +3558,24 @@ sub SearchTitleAndBody {
return @found;
}
sub Filtered { # this is overwriten in extensions such as tags.pl
# 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 {
my ($string, @pages) = @_;
my $match = GetParam('match', '');
@pages = grep /$match/i, @pages if $match;
return @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 = $_;
for (@terms) { return unless $id =~ /$_/i }
return $id;
} @pages;
}
sub SearchString {
@@ -3873,12 +3910,16 @@ sub TouchIndexFile {
sub GetLanguages {
my $text = shift;
my @result;
for my $lang (sort keys %Languages) {
my %result;
for my $lang (keys %Languages) {
my @matches = $text =~ /$Languages{$lang}/gi;
push(@result, $lang) if $#matches >= $LanguageLimit;
$result{$lang} = @matches if @matches >= $LanguageLimit;
}
return join(',', @result);
return join(',', sort { $result{$b} <=> $result{$a} } keys %result);
}
sub GetLanguage { # the first language, or the default language
return ((split /,/, GetLanguages(@_))[0] or $CurrentLanguage);
}
sub GetCluster {