# -*- mode: cperl -*- use utf8; do '/org/org.emacswiki/htdocs/password.pl'; # $0 is wiki, emacs, emacs-en, emacs-de, etc $ScriptName = "http://www.emacswiki.org/$0"; $FullUrl = "http://www.emacswiki.org/cgi-bin/$0"; $UseGrep = 0; # lock down (alternatively use the $NoEditFile via admin page) $EditAllowed = 1; $ReCaptchaRememberAnswer = 1; $QuestionaskerSecretKey = 'uihnscuskc'; $ReCaptchaSecretKey = $QuestionaskerSecretKey; @QuestionaskerQuestions = (['What is the greatest editor out there?' => sub { shift =~ /^\s*(x?emacs|vim?|pico|nano|ed(lin)?|notepad|(ultra)?edit|text(pad|mate))\s*$/i }], ); # $SurgeProtectionTime = 100; # Size of the protected window in seconds # $SurgeProtectionViews = 10; # How many page views to allow in this window $SummaryHours = 0; $NotFoundHandlerDir = "$DataDir/wiki"; $CommentsPrefix = 'Comments_on_'; $CalendarOnEveryPage = 0; $UploadAllowed = 1; $MaxPost = 1024000; $UseDiff = 1; $MultiUrlLimit = 10; $GitMail = 'anybody@emacswiki.org'; # $ENV{GIT_COMMITTER_NAME} = 'Alex Schroeder'; # $ENV{GIT_COMMITTER_EMAIL} = 'alex@gnu.org'; push(@UploadTypes,'text/css'); push(@UploadTypes,'text/plain'); push(@UploadTypes,'text/xml'); push(@UploadTypes,'text/x-emacs-lisp'); push(@UploadTypes,'image/x-png'); # PNG is usually broken on Windows push(@UploadTypes,'application/tar'); # gzip files push(@UploadTypes,'application/gzip'); # gzip for dds push(@UploadTypes,'application/gzip-compressed'); # gzip for DrewAdams push(@UploadTypes,'application/zip-compressed'); # zip for leooo push(@UploadTypes,'application/x-tar'); # gzip files push(@UploadTypes,'application/x-gzip'); # gzip for dds push(@UploadTypes,'application/x-gzip-compressed'); # gzip for DrewAdams push(@UploadTypes,'application/x-zip-compressed'); # zip for leooo push(@UploadTypes,'image/gif'); # gif for JaariAlto %StaticMimeTypes = ('text/css' => 'css', 'text/plain' => 'txt', 'text/xml' => 'xml', 'text/x-emacs-lisp' => 'el', 'application/x-tar' => 'tar.gz', 'application/x-gzip' => 'gz', 'application/x-gzip-compressed' => 'gz', 'image/png' => 'png', 'image/x-png' => 'png', 'image/jpeg' => 'jpg', 'image/pjpeg' => 'jpg'); $StaticAlways = 1; $StaticDir = '/org/org.emacswiki/htdocs/pics/static'; $StaticUrl = 'http://www.emacswiki.org/pics/static/'; push(@MyInitVariables, sub { if (GetParam('action', 'browse') eq 'static' and GetParam('html', 1) == 1) { # Ordinary static action defaults to html=1 and is used to # create the static tar ball. In this case want to create the # static stuff in a different directory. $StaticDir = '/org/org.emacswiki/htdocs/emacs/static'; } }); $CookieName = "Wiki"; $SiteName = "EmacsWiki"; $HomePage = "SiteMap"; $LogoUrl = "/emacs_logo.png"; $RcDefault = 7; @RcDays = qw(1 3 7 14 21 28); $KeepDays = 21; $SisterSiteLogoUrl = '/pics/%s.png'; $InstanceThrottleLimit = 10; $TocAnchorPrefix = 'toc'; $TocOutlineLibrary = '/outliner.0.5.0.62-toc.js'; $MarkupSingles{'=>'} = '⇒'; # RIGHTWARDS DOUBLE ARROW $MarkupSingles{'==>'} = '⇒'; # RIGHTWARDS DOUBLE ARROW $MarkupSingles{'-->'} = '→'; # RIGHTWARDS ARROW # delete $Smilies{':-?[/\\\]'}; # delete $Smilies{'=-?\)'}; # weird crash! # $Smilies{'=\)'} = 'http://www.emacswiki.org/pics/bigeye-smile.png', # $Smilies{':-?/'} = 'http://www.emacswiki.org/pics/wry.png'; # $Smilies{':-\\'} = 'http://www.emacswiki.org/pics/wry.png'; # Allow + in pagenames: push(@MyInitVariables, sub { $FreeLinkPattern = "([-+,.()' _0-9A-Za-z\x{0080}-\x{fffd}]+)"; }); # Somehow this leads to problems such as links having the URL # http://www.emacswiki.org/cgi-bin/wiki/info+.el/RecentChanges # from the info+.el page. # CGI bug report submitted. For the time being, make sure # to use an older CGI library! $FooterNote = qq{
This work is licensed to you under version 2 of the GNU General Public License. Alternatively, you may choose to receive this work under any other license that grants the right to use, copy, modify, and/or distribute the work, as long as that license imposes the restriction that derivative works have to grant the same rights and impose the same restriction. For example, you may choose to receive this work under the GNU Free Documentation License, the CreativeCommons ShareAlike License, the XEmacs manual license, or similar licenses.
}; $RssRights = "This work is licensed to you under version 2 of the GNU General Public License. Alternatively, you may choose to receive this work under any other license that grants the right to use, copy, modify, and distribute the work, as long as that license imposes the restriction that derivative works have to grant the same rights and impose the same restriction. For example, you may choose to receive this work under the GNU Free Documentation License, the CreativeCommons ShareAlike License, the XEmacs manual license, or similar licenses."; $RssLicense = ['http://creativecommons.org/licenses/sa/1.0/', 'http://www.gnu.org/copyleft/fdl.html', 'http://www.gnu.org/copyleft/gpl.html', 'http://www.emacswiki.org/OLD' ]; $EditNote = 'Please make sure you contribute only your own work. IP numbers are made available via the page history. If you want to keep it a secret, you need to use Tor. See TextFormattingRules for how to format text. See StyleGuide for the suggested writing style on this wiki.
'; $HttpCharset = "UTF-8"; @UserGotoBarPages = ($HomePage, 'Search', 'ElispArea', 'HowTo', 'Glossary', $RCName, 'News', 'Problems', 'Suggestions'); # $UserGotoBar = "$_"; } sub MyRules { # source code on pages start with a comment on the first line if (pos == 0 and m/\G;;;/gc) { my $result = elisp_formatting($_); pos = length($_); my $link; my $revision = GetParam('revision', ''); my $page = UrlEncode($OpenPageName); if ($revision) { # hack alert: I want the URL to end in $page such that saving # the old revision results in a reasonable name suggestion by # the browser $link = "$ScriptName/download/$page?revision=$revision"; } else { $link = ScriptUrl("download/$page"); } return CloseHtmlEnvironments() . $q->p({-class=>"download"}, $q->a({-href=>$link}, T("Download"))) . $result; } elsif (pos == 0 and m%\G#! ?/usr/bin/perl%gc) { my $pos = length($_); # fake matching entire file my $source = $_; require Beautifier::Core; require HFile::HFile_perl; require Output::CSS; my $Hfile = new HFile::HFile_perl; my $highlighter = new Beautifier::Core($Hfile, new Output::CSS); my $result = $highlighter->highlight_text(UnquoteHtml($source)); pos = $pos; return $q->p(ScriptLink("download/$OpenPageName", T("Download"))) . $result; } elsif (pos == 0 and m!\G(\#|/\*)!gc) { # for any sort of raw page my $pos = length($_); # fake matching entire file pos = $pos; return $q->p(ScriptLink("download/$OpenPageName", T("Download"))) . $q->pre($_); } elsif ( /\G`##([\/*a-z0-9 -]+)##'/cgi or /\G`([\/*a-z0-9 -]+)\'/cgi or /\G‘([\/*a-z0-9 -]+)’/cgi) { # Emacs `syntax' or copy & paste ‘syntax’ return $q->code('‘' . $1 . '’'); } elsif ($bol && m/\G(\<include\s+list\s+"(.*?)"\>[ \t]*\n?)/cgi) { my ($oldpos, $old_) = (pos, $_); Clean(CloseHtmlEnvironments()); Dirty($1); my $re = UnquoteHtml($2); my @pages = map { GetPageLink($_) } grep(/$re/, AllPagesList()); print $q->ul($q->li(\@pages)); ($_, pos) = ($old_, $oldpos); # restore \G return AddHtmlEnvironment('p'); } elsif ($bol && m/\G(\<include\s+gist\s+"(https:\/\/gist\.github\.com\/[0-9]+)"\>[ \t]*\n?)/cgi) { #
for monospaced, preformatted and escaped
my ($oldpos, $old_) = (pos, $_);
my $html = CloseHtmlEnvironments()
. elisp_formatting($1) . AddHtmlEnvironment('p');
($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
return $html;
} elsif ($bol && m/\G(\s*\n)*([ \t]+.+)\n?/gc) {
# usemod.pl: indented for monospaced, preformatted and escaped
my $str = $2;
while (m/\G([ \t]+.*)\n?/gc) {
$str .= "\n" . $1;
}
my ($oldpos, $old_) = (pos, $_);
my $html = CloseHtmlEnvironments()
. elisp_formatting($str) . AddHtmlEnvironment('p');
($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
return $html;
} elsif ($bol && m/\G{{{\n?(.*?\n)}}}[ \t]*\n?/cgs) {
# marku.pl: for monospaced, preformatted and escaped
my ($oldpos, $old_) = (pos, $_);
my $html = CloseHtmlEnvironments()
. elisp_formatting($1) . AddHtmlEnvironment('p');
($_, pos) = ($old_, $oldpos); # restore \G (assignment order matters!)
return $html;
} elsif (m/\G\[\[Manual:([^]|]+?)(\|([^]]+?))?\]\](\s+\((.*?)\))?/cog
or m/\G\[Manual:([^]]+?)(\s+([^]]+?))?\](\s+\((.*?)\))?/cog
or m/\GManual:(((\S+)))(\s+\((.*?)\))?/cog) {
my ($key, $text, $context) = ($1, $3, $5);
$text ||= $key;
my $url = 'http://www.emacswiki.org/cgi-bin/info-ref?find=' . UrlEncode($key);
$url .= ';context=' . UrlEncode($context) if $context;
return $q->a({-href=>$url, -class=>'manual'}, $text);
# } elsif (m/\G\<(div (class|style)="[^\"]+")\>/cgi or m/\G\<(\/div)\>/cgi) {
# return CloseHtmlEnvironments() . '<' . UrlDecode($1) . '>';
}
return undef;
}
@Debugging = (sub {
print $q->p($BannedRegexps) . $q->pre(QuoteHtml(GetPageContent($BannedRegexps)));
});
push(@MyInitVariables, sub {
# take the opportunity to clean out some stuff
delete $AdminPages{$RssInterwikiTranslate};
delete $AdminPages{$StyleSheetPage};
});
# nice text to encourage page creation
push(@MyInitVariables, sub {
my $id = GetId();
$NewText = Ts('This page does not exist, but you can %s.',
'[' . ScriptUrl('action=edit;id=' . UrlEncode($id)) . ' '
. T('create it now') . ']')
if $id;
});
# overwrite existing function to handle ForANew and the like
sub UnWiki {
my $str = shift;
return $str unless $WikiLinks and $str =~ /^$LinkPattern$/;
$str =~ s/([[:lower:]])([[:upper:]])/$1 $2/g;
$str =~ s/\b([[:upper:]])([[:upper:]][[:lower:]])/$1 $2/g;
return $str;
}
# Add a space between WikiLink segments without compromising copy&paste ability.
*MyOldGetHeader=*GetHeader;
*GetHeader=*MyNewGetHeader;
sub MyNewGetHeader {
my $html = MyOldGetHeader(@_);
my $prefix = $CommentsPrefix;
$prefix =~ s/_/ /g;
return $html unless $WikiLinks and $html =~ /(<(a.*?)>)?($prefix)?$LinkPattern(<\/a>)?<\/h1>/;
my $str = UnWiki($4);
$str = join('', map { $q->span({-style=>"padding-right: 0.5ex;"}, $_) } split(/ +/, $str));
$html =~ s/()($prefix)?$LinkPattern(<\/a>)?<\/h1>/$1$2$str$4<\/h1>/;
return $html;
}
$Action{elisp} = \&DoElisp; # for dim and el-get
sub DoElisp {
SetParam('raw', 1);
DoElispArea();
}
$Action{'elisp-area'} = \&DoElispArea;
# changes to this code won't have an immediate effect because a static
# page generated by bin/emacs-elisp-area is getting served instead
# (see cgi-bin/.htaccess)
sub DoElispArea {
my $raw = GetParam('raw');
my $match = GetParam('match', '\.(el|tar)(\.gz)?$'); #'
my $context = GetParam('context', 1);
if ($raw) {
print GetHttpHeader('text/plain');
} else {
print GetHeader('', T('Elisp Area!'));
print $q->start_div({-class=>'content elisp'});
if ($context) {
print $q->p(Ts('Switch to a %s.', ScriptLink('action=elisp-area;context=0', T('compact list'))));
} else {
print $q->p(Ts('Switch to a %s.', ScriptLink('action=elisp-area', T('list with more context'))));
}
print '
' unless $context;
}
foreach my $id (grep(/$match/, AllPagesList())) {
next if $CommentsPrefix and $id =~ /^$CommentsPrefix(.*)/o;
OpenPage($id);
next if $Page{text} =~ /^#REDIRECT/;
if ($raw) {
if ($Page{text} =~ /^(.+)/ and substr($Page{text}, 0, 5) ne '#FILE') {
print "$id $1\n";
} else {
print "$id\n";
}
} elsif ($context) {
my $desc;
if ($Page{text} =~ /^;;; (.+)/) {
$desc = $1;
my $re = quotemeta($id);
$desc =~ s/$re --?-? ?//;
}
print $q->p(GetPageLink($id)
. ' (' . GetHistoryLink($id, T('history')) . ', '
. ScriptLinkDiff(1, $id, T('diff')) . ')'
. $q->br()
. ($desc ? $q->em($desc) . $q->br() : '')
. T('Last edited') . ' ' . TimeToText($Page{ts}) . ' '
. Ts('by %s', GetAuthorLink($Page{host}, $Page{username})));
} else {
print $q->Tr($q->td(GetPageLink($id)),
$q->td(TimeToText($Page{ts})),
$q->td(ScriptLinkDiff(1, $id, T('diff'))));
}
}
return if $raw;
print '
' unless $context;
print $q->end_div();
PrintFooter();
}
## comments
*MyOldGetFooterLinks = *GetFooterLinks;
*GetFooterLinks = *MyNewGetFooterLinks;
sub MyNewGetFooterLinks {
my $html = MyOldGetFooterLinks(@_);
my ($id, $rev) = @_;
if ($id and $rev ne 'history' and $rev ne 'edit'
and $CommentsPrefix) {
if ($id =~ /^$CommentsPrefix(.*)/o) {
my $from = NormalToFree($1);
my $to = T('Article');
$html =~ s/>$from accesskey="a">$to;
} else {
my $from = NormalToFree($CommentsPrefix . $id);
my $to = T('Talk');
$html =~ s/$from/$to/;
}
}
return $html;
}
### Needs Attention
$Action{fixme} = \&DoFixme;
my $fixme = 'CategoryNeedsAttention';
sub DoFixme {
my $id = shift;
my $reason = GetParam('reason');
ValidIdOrDie($id);
ReportError(Ts('You must provide a reason.', $id), '400 BAD REQUEST') unless $reason;
ReportError(Ts('Editing not allowed for %s.', $id), '403 FORBIDDEN') unless UserCanEdit($id, 1);
ReportError(T('A username is required for ordinary users.'), '403 FORBIDDEN') unless GetParam('username', '') or UserIsEditor();
print GetHeader('', T('This page needs attention'));
# Lock before getting old page to prevent races
RequestLockOrError();
OpenPage($id);
OpenPage($id);
my $text = $Page{text};
if ($text =~ /$fixme/io) {
print $q->p(Ts('This page is already marked with %s.',
GetPageLink($fixme)));
} else {
$text .= "\n" unless $text =~ /\n\n$/;
$text .= $fixme . " ($reason)\n";
Save($id, $text, T('This page needs attention'));
print $q->p(Tss('%1 has been marked with %2.',
GetPageLink($id),
GetPageLink($fixme)));
}
ReleaseLock();
PrintFooter();
}
push(@MyAdminCode, \&FixmeMenu);
sub FixmeMenu {
my ($id, $menuref, $restref) = @_;
if ($id) {
# push(@$menuref, ScriptLink('action=fixme;id=' . UrlEncode(FreeToNormal($id)),
# Ts('%s needs attention', NormalToFree($id)), 'fixme'));
push(@$menuref, GetFormStart()
. $q->label({-for=>'fixme'}, Ts('%s needs attention: ', NormalToFree($id)))
. GetHiddenValue('action', 'fixme')
. GetHiddenValue('id', UrlEncode(FreeToNormal($id)))
. $q->textfield(-name=>'reason', -size=>20)
. $q->submit(T('Save')));
}
}
push(@MyInitVariables, sub {
my $id = GetId();
if (GetParam('action', 'browse') eq 'browse') {
OpenPage($id);
if ($Page{text} =~ /$fixme/io) {
$Message .= $q->p(T('This page needs attention!'));
}
}
});
# making it easy to ban hosts
push(@MyAdminCode, \&BanMenu);
sub BanMenu {
my ($id, $menuref, $restref) = @_;
if ($id and UserIsAdmin()) {
push(@$menuref, ScriptLink('action=ban;id=' . UrlEncode($id),
T('Ban contributors')));
}
}
$Action{ban} = \&DoBanHosts;
sub IsHostBanned {
my ($host, $regexps) = @_;
foreach my $regexp (@$regexps) {
return $host if ($host =~ /$regexp/i);
}
}
sub DoBanHosts {
my $id = shift;
my $host = GetParam('host', '');
if ($host) {
$host =~ s/\./\\./g;
SetParam('text', GetPageContent($BannedHosts)
. "^" . $host . " # " . CalcDay($Now) . " "
. NormalToFree($id) . "\n");
SetParam('summary', NormalToFree($id));
DoPost($BannedHosts);
} else {
ValidIdOrDie($id);
print GetHeader('', Ts('Ban Contributors to %s', NormalToFree($id)));
SetParam('rcidonly', $id);
SetParam('all', 1);
my %contrib = ();
for my $line (GetRcLines()) {
$contrib{$line->[4]}->{$line->[5]} = 1 if $line->[4];
}
my @regexps = ();
foreach (split(/\n/, GetPageContent($BannedHosts))) {
if (/^\s*([^#]\S+)/) { # all lines except empty lines and comments, trim whitespace
push(@regexps, $1);
}
}
print '';
foreach (sort(keys %contrib)) {
my $name = $_;
delete $contrib{$_}{''};
$name .= " (" . join(", ", sort(keys(%{$contrib{$_}}))) . ")";
if (IsHostBanned($_, \@regexps)) {
print $q->p(Ts("%s is banned", $name));
} else {
print GetFormStart(undef, 'get', 'ban'),
GetHiddenValue('action', 'ban'),
GetHiddenValue('id', $id),
GetHiddenValue('host', $_),
GetHiddenValue('recent_edit', 'on'),
$q->p($name, $q->submit(T('Ban!'))), $q->end_form();
}
}
}
PrintFooter();
}
# make maintenance inaccessible for random visitors
delete $Action{maintain};
$Action{maintjob} = \&DoAdminMaintenance;
sub DoAdminMaintenance {
UserIsAdminOrError();
DoMaintenance();
}