forked from github/kensanata.oddmuse
333 lines
9.3 KiB
Perl
333 lines
9.3 KiB
Perl
# Copyright (C) 2005, Alex Schroeder <alex@emacswiki.org>
|
|
# Copyright (C) 2004, Leon Brocard
|
|
|
|
# This module is free software; you can redistribute it or modify it
|
|
# under the same terms as Perl itself.
|
|
|
|
use CGI;
|
|
# use Data::Dumper;
|
|
|
|
package OddMuse;
|
|
|
|
*DavOldDoBrowseRequest = *DoBrowseRequest;
|
|
*DoBrowseRequest = *DavNewDoBrowseRequest;
|
|
|
|
sub DavNewDoBrowseRequest {
|
|
my $dav = new OddMuse::DAV;
|
|
$dav->run($q)||DavOldDoBrowseRequest();
|
|
}
|
|
|
|
# my $etag = PageEtag();
|
|
# my $type = 'application/xml';
|
|
# my %headers = (-cache_control=>($UseCache < 0 ? 'no-cache' : 'max-age=10'));
|
|
# $headers{-etag} = $etag if GetParam('cache', $UseCache) >= 2;
|
|
# if ($HttpCharset ne '') {
|
|
# $headers{-type} = "$type; charset=$HttpCharset";
|
|
# } else {
|
|
# $headers{-type} = $type;
|
|
# }
|
|
|
|
# sub Dav {
|
|
# my ($tag, @content) = @_;
|
|
# my $content = join("\n", @content);
|
|
# my $nl = ($#content == 1 and length($content) > 40) ? "\n" : "";
|
|
# return "<D:$tag>$nl$content$nl</D:$tag>\n";
|
|
# }
|
|
|
|
# sub Link {
|
|
# return $ScriptName . ($UsePathInfo ? '/' : '?') . shift;
|
|
# }
|
|
|
|
package OddMuse::DAV;
|
|
use strict;
|
|
use warnings;
|
|
use Encode;
|
|
use HTTP::Date qw(time2str time2isoz);
|
|
use HTTP::Headers;
|
|
use HTTP::Response;
|
|
use HTTP::Request;
|
|
use File::Spec;
|
|
use URI;
|
|
use URI::Escape;
|
|
use XML::LibXML;
|
|
|
|
# These are the methods we understand -- but not all of them are truly
|
|
# implemented.
|
|
our %implemented = (
|
|
get => 1,
|
|
head => 1,
|
|
options => 1,
|
|
propfind => 1,
|
|
put => 1,
|
|
trace => 1,
|
|
unlock => 1,
|
|
);
|
|
|
|
sub new {
|
|
my ($class) = @_;
|
|
my $self = {};
|
|
bless $self, $class;
|
|
return $self;
|
|
}
|
|
|
|
sub run {
|
|
my ($self, $q) = @_;
|
|
|
|
my $path = decode_utf8 uri_unescape $q->path_info;
|
|
return 0 if $path !~ m|/dav|;
|
|
|
|
my $method = $q->request_method;
|
|
$method = lc $method;
|
|
warn uc $method, " ", $path, "\n";
|
|
if (not $implemented{$method}) {
|
|
print $q->header( -status => '501 Not Implemented', );
|
|
return 1;
|
|
}
|
|
|
|
$self->$method($q);
|
|
return 1;
|
|
}
|
|
|
|
sub options {
|
|
my ($self, $q) = @_;
|
|
print $q->header( -DAV => '1',
|
|
-allow => join(',', map { uc } keys %implemented),
|
|
-status => "200 OK", );
|
|
}
|
|
|
|
sub head {
|
|
get(@_, 1);
|
|
}
|
|
|
|
sub get {
|
|
my ($self, $q, $head) = @_;
|
|
my $id = OddMuse::GetId();
|
|
OddMuse::AllPagesList();
|
|
if ($OddMuse::IndexHash{$id}) {
|
|
OddMuse::OpenPage($id);
|
|
if (OddMuse::FileFresh()) {
|
|
print $q->header( -status => '304 Not Modified', );
|
|
} else {
|
|
my $cookie = OddMuse::Cookie();
|
|
print $q->header( -cache_control => 'max-age=10',
|
|
-etag => $OddMuse::Page{ts},
|
|
-type => "text/plain; charset=$OddMuse::HttpCharset",
|
|
-status => "200 OK",
|
|
-cookie => $cookie);
|
|
print $OddMuse::Page{text} unless $head;
|
|
}
|
|
} else {
|
|
print $q->header( -status => "404 Not Found", );
|
|
print $OddMuse::NewText unless $head;
|
|
}
|
|
}
|
|
|
|
sub put {
|
|
my ($self, $q) = @_;
|
|
my $id = OddMuse::GetId();
|
|
my $text = body();
|
|
OddMuse::SetParam('text', $text);
|
|
*OddMuse::ReBrowsePage = *created;
|
|
OddMuse::DoPost($id);
|
|
}
|
|
|
|
sub created {
|
|
print CGI::header( -status => "201 Created", );
|
|
}
|
|
|
|
sub propfind {
|
|
my ($self, $q) = @_;
|
|
my $depth = $q->http('depth') || "infinity";
|
|
# warn "depth: $depth\n";
|
|
|
|
my $content = body();
|
|
# warn "content: $content\n";
|
|
|
|
my $parser = XML::LibXML->new;
|
|
my $req;
|
|
eval { $req = $parser->parse_string($content); };
|
|
if ($@) {
|
|
print $q->header( -status => "400 Bad Request", );
|
|
print $@;
|
|
return;
|
|
}
|
|
# warn "req: " . $req->toString;
|
|
|
|
# what properties do we need?
|
|
my $reqinfo;
|
|
my @reqprops;
|
|
$reqinfo = $req->find('/*/*')->shift->localname;
|
|
if ($reqinfo eq 'prop') {
|
|
for my $node ($req->find('/*/*/*')->get_nodelist) {
|
|
push @reqprops, [ $node->namespaceURI, $node->localname ];
|
|
}
|
|
}
|
|
# warn "reqprops: " . join(", ", map {join "", @$_} @reqprops) . "\n";
|
|
|
|
# collection only, all pages, or single page?
|
|
my @pages = OddMuse::AllPagesList();
|
|
if ($q->path_info =~ '^/dav/?$') {
|
|
# warn "collection!\n";
|
|
if ($depth eq "0") {
|
|
# warn "only the collection!\n";
|
|
@pages = ('');
|
|
} else {
|
|
# warn "all pages!\n";
|
|
unshift(@pages, '');
|
|
}
|
|
} else {
|
|
my $id = OddMuse::GetId();
|
|
# warn "single page, id: $id\n";
|
|
if (not $OddMuse::IndexHash{$id}) {
|
|
print $q->header( -status => "404 Not Found", );
|
|
print $OddMuse::NewText;
|
|
return;
|
|
}
|
|
@pages = ($id);
|
|
}
|
|
print $q->header( -status => "207 Multi-Status", );
|
|
|
|
my $doc = XML::LibXML::Document->new('1.0', 'utf-8');
|
|
my $multistat = $doc->createElement('D:multistatus');
|
|
$multistat->setAttribute('xmlns:D', 'DAV:');
|
|
$doc->setDocumentElement($multistat);
|
|
|
|
for my $id (@pages) {
|
|
my ($size, $mtime, $ctime) = ('', '', ''); # undefined for the wiki proper ($id eq '')
|
|
if ($id) { # ordinary page
|
|
OddMuse::OpenPage($id);
|
|
$size = length($OddMuse::Page{text});
|
|
$mtime = $OddMuse::Page{ts};
|
|
$ctime = 0;
|
|
|
|
# modified time is stringified human readable HTTP::Date style
|
|
$mtime = time2str($mtime);
|
|
|
|
# created time is ISO format
|
|
# tidy up date format - isoz isn't exactly what we want, but
|
|
# it's easy to change.
|
|
$ctime = time2isoz($ctime);
|
|
$ctime =~ s/ /T/;
|
|
$ctime =~ s/Z//;
|
|
|
|
# force empty strings if undefined
|
|
$size ||= '';
|
|
}
|
|
|
|
my $resp = $doc->createElement('D:response');
|
|
$multistat->addChild($resp);
|
|
my $href = $doc->createElement('D:href');
|
|
$href->appendText($OddMuse::ScriptName . '/dav/' . uri_escape encode_utf8 $id);
|
|
$resp->addChild($href);
|
|
my $okprops = $doc->createElement('D:prop');
|
|
my $nfprops = $doc->createElement('D:prop');
|
|
my $prop;
|
|
|
|
if ($reqinfo eq 'prop') {
|
|
my %prefixes = ('DAV:' => 'D');
|
|
my $i = 0;
|
|
|
|
for my $reqprop (@reqprops) {
|
|
my ($ns, $name) = @$reqprop;
|
|
if ($ns eq 'DAV:' && $name eq 'creationdate') {
|
|
$prop = $doc->createElement('D:creationdate');
|
|
$prop->appendText($ctime);
|
|
$okprops->addChild($prop);
|
|
} elsif ($ns eq 'DAV:' && $name eq 'getcontentlength') {
|
|
$prop = $doc->createElement('D:getcontentlength');
|
|
$prop->appendText($size);
|
|
$okprops->addChild($prop);
|
|
} elsif ($ns eq 'DAV:' && $name eq 'getcontenttype') {
|
|
$prop = $doc->createElement('D:getcontenttype');
|
|
$prop->appendText('text/plain');
|
|
$okprops->addChild($prop);
|
|
} elsif ($ns eq 'DAV:' && $name eq 'getlastmodified') {
|
|
$prop = $doc->createElement('D:getlastmodified');
|
|
$prop->appendText($mtime);
|
|
$okprops->addChild($prop);
|
|
} elsif ($ns eq 'DAV:' && $name eq 'resourcetype') {
|
|
$prop = $doc->createElement('D:resourcetype');
|
|
if (not $id) { # change for namespaces later
|
|
my $col = $doc->createElement('D:collection');
|
|
$prop->addChild($col);
|
|
}
|
|
$okprops->addChild($prop);
|
|
} else {
|
|
my $prefix = $prefixes{$ns};
|
|
if (!defined $prefix) {
|
|
$prefix = 'i' . $i++;
|
|
|
|
# mod_dav sets <response> 'xmlns' attribute - whatever
|
|
#$nfprops->setAttribute("xmlns:$prefix", $ns);
|
|
$resp->setAttribute("xmlns:$prefix", $ns);
|
|
|
|
$prefixes{$ns} = $prefix;
|
|
}
|
|
|
|
$prop = $doc->createElement("$prefix:$name");
|
|
$nfprops->addChild($prop);
|
|
}
|
|
}
|
|
} elsif ($reqinfo eq 'propname') {
|
|
$prop = $doc->createElement('D:creationdate');
|
|
$okprops->addChild($prop);
|
|
$prop = $doc->createElement('D:getcontentlength');
|
|
$okprops->addChild($prop);
|
|
$prop = $doc->createElement('D:getcontenttype');
|
|
$okprops->addChild($prop);
|
|
$prop = $doc->createElement('D:getlastmodified');
|
|
$okprops->addChild($prop);
|
|
$prop = $doc->createElement('D:resourcetype');
|
|
$okprops->addChild($prop);
|
|
} else {
|
|
$prop = $doc->createElement('D:creationdate');
|
|
$prop->appendText($ctime);
|
|
$okprops->addChild($prop);
|
|
$prop = $doc->createElement('D:getcontentlength');
|
|
$prop->appendText($size);
|
|
$okprops->addChild($prop);
|
|
$prop = $doc->createElement('D:getcontenttype');
|
|
$prop->appendText('text/plain');
|
|
$okprops->addChild($prop);
|
|
$prop = $doc->createElement('D:getlastmodified');
|
|
$prop->appendText($mtime);
|
|
$okprops->addChild($prop);
|
|
$prop = $doc->createElement('D:resourcetype');
|
|
if (not $id) { # change for namespaces later
|
|
my $col = $doc->createElement('D:collection');
|
|
$prop->addChild($col);
|
|
}
|
|
$okprops->addChild($prop);
|
|
}
|
|
|
|
if ($okprops->hasChildNodes) {
|
|
my $propstat = $doc->createElement('D:propstat');
|
|
$propstat->addChild($okprops);
|
|
my $stat = $doc->createElement('D:status');
|
|
$stat->appendText('HTTP/1.1 200 OK');
|
|
$propstat->addChild($stat);
|
|
$resp->addChild($propstat);
|
|
}
|
|
|
|
if ($nfprops->hasChildNodes) {
|
|
my $propstat = $doc->createElement('D:propstat');
|
|
$propstat->addChild($nfprops);
|
|
my $stat = $doc->createElement('D:status');
|
|
$stat->appendText('HTTP/1.1 404 Not Found');
|
|
$propstat->addChild($stat);
|
|
$resp->addChild($propstat);
|
|
}
|
|
}
|
|
# warn $doc->toString(1);
|
|
print $doc->toString(1);
|
|
}
|
|
|
|
sub body {
|
|
local $/ = undef; # slurp
|
|
return <STDIN>; # can only be read once!
|
|
}
|
|
|
|
# my $dav = new OddMuse::DAV;
|
|
# my $q = new CGI;
|
|
# print $dav->run($q);
|