pingback-server.pl 4.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141
  1. # Copyright (C) 2004 Brock Wilcox <awwaiid@thelackthereof.org>
  2. # Copyright (C) 2019 Alex Schroeder <alex@gnu.org>
  3. #
  4. # This program is free software; you can redistribute it and/or modify
  5. # it under the terms of the GNU General Public License as published by
  6. # the Free Software Foundation; either version 3 of the License, or
  7. # (at your option) any later version.
  8. #
  9. # This program is distributed in the hope that it will be useful,
  10. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. # GNU General Public License for more details.
  13. #
  14. # You should have received a copy of the GNU General Public License
  15. # along with this program. If not, see <http://www.gnu.org/licenses/>.
  16. use strict;
  17. use v5.10;
  18. use LWP::UserAgent;
  19. use RPC::XML::Parser;
  20. use RPC::XML;
  21. AddModuleDescription('pingback-server.pl', 'Pingback Server Extension');
  22. # Specification: http://www.hixie.ch/specs/pingback/pingback
  23. # XML-RPC errors: http://xmlrpc-epi.sourceforge.net/specs/rfc.fault_codes.php
  24. our ($CommentsPrefix, $q, $HtmlHeaders, %Action, $QuestionaskerSecretKey,
  25. @MyInitVariables, %IndexHash);
  26. push(@MyInitVariables, \&PingbackServerAddLink);
  27. sub PingbackServerAddLink {
  28. SetParam('action', 'pingback') if $q->path_info =~ m|/pingback\b|;
  29. my $id = GetId();
  30. return unless $id;
  31. return if $id =~ /^$CommentsPrefix/;
  32. my $link = '<link rel="alternate" type="application/wiki" href="'
  33. . ScriptUrl('pingback/' . UrlEncode($id)) . '" />';
  34. $HtmlHeaders .= $link unless index($HtmlHeaders, /$link/) != -1;
  35. }
  36. $Action{pingback} = \&DoPingbackServer;
  37. sub DoPingbackServer {
  38. my $id = FreeToNormal(shift);
  39. # some sanity checks for the request
  40. if ($q->request_method() ne 'POST') {
  41. ReportError(T('Only XML-RPC POST requests recognised'), '405 METHOD NOT ALLOWED');
  42. }
  43. if ($q->content_type() ne 'text/xml') {
  44. ReportError(T('Only XML-RPC POST requests recognised'), '415 UNSUPPORTED MEDIA TYPE');
  45. }
  46. # some sanity checks for the target page name
  47. if (not $id) {
  48. PingbackServerFault('400 NO ID', 33, "No page specified");
  49. }
  50. my $error = ValidId($id);
  51. if ($error) {
  52. PingbackServerFault('400 INVALID ID', 33, "Invalid page name: $id");
  53. }
  54. # check the IP number for bans
  55. my $rule = UserIsBanned();
  56. if ($rule) {
  57. PingbackServerFault('403 FORBIDDEN', 49, "Your IP number is blocked");
  58. }
  59. # check that the target page exists
  60. AllPagesList();
  61. if (not $IndexHash{$id}) {
  62. PingbackServerFault('404 NOT FOUND', 32, "Page does not exist: $id");
  63. }
  64. # parse the remote procedure call
  65. my $data = $q->param('POSTDATA');
  66. my $parser = RPC::XML::Parser->new();
  67. my $request = $parser->parse($data);
  68. if (not ref($request)) {
  69. PingbackServerFault('400 NO DATA', -32700, "Could not parse XML-RPC");
  70. }
  71. # sanity check the function and argument number
  72. my $name = $request->name;
  73. my $arguments = $request->args;
  74. if ($name ne 'pingback.ping') {
  75. PingbackServerFault('501 NOT IMPLEMENTED', -32601, "Method $name not supported");
  76. }
  77. if (@$arguments != 2) {
  78. PingbackServerFault('400 WRONG NUMBER OF ARGS', -32602, "Wrong number of arguments");
  79. }
  80. # extract the two arguments
  81. my $source = $arguments->[0]->value;
  82. my $target = $arguments->[1]->value;
  83. # verify that the source isn't banned
  84. $rule = BannedContent($source);
  85. if ($rule) {
  86. PingbackServerFault('403 FORBIDDEN', 49, "The URL is blocked");
  87. }
  88. # verify that the pingback is legit
  89. my $ua = LWP::UserAgent->new;
  90. my $response = $ua->get($source);
  91. if (not $response->is_success) {
  92. PingbackServerFault('400 NO SOURCE', 16, "Cannot retrieve $source");
  93. }
  94. my $self = ScriptUrl(UrlEncode($id));
  95. if ($response->decoded_content !~ /$self/) {
  96. PingbackServerFault('403 FORBIDDEN', "$source does not link to $self");
  97. }
  98. $id = $CommentsPrefix . $id;
  99. if (GetPageContent($id) =~ /$source/) {
  100. PingbackServerFault('400 ALREADY REGISTERED', 48, "$source has already been registered");
  101. }
  102. # post a comment without redirect at the end
  103. SetParam('aftertext', 'Pingback: ' . $source);
  104. SetParam('summary', 'Pingback');
  105. SetParam('username', T('Anonymous'));
  106. SetParam($QuestionaskerSecretKey, 1) if $QuestionaskerSecretKey;
  107. local *ReBrowsePage = sub {};
  108. DoPost($id);
  109. # response
  110. my $message = "Oddmuse PingbackServer! $id OK";
  111. my $response = RPC::XML::response->new(RPC::XML::string->new($message));
  112. print GetHttpHeader('text/xml', 'nocache', '200 OK'), $response->as_string, "\n\n";
  113. }
  114. sub PingbackServerFault {
  115. my($status, $error, $data) = @_;
  116. my $fault = RPC::XML::response->new(RPC::XML::fault->new($error, $data));
  117. print GetHttpHeader('text/xml', 'nocache', $status), $fault->as_string, "\n\n";
  118. exit 2;
  119. }