view release on metacpan or  search on metacpan

lib/App/Phoebe/WebDAV.pm  view on Meta::CPAN

# -*- mode: perl -*-
# Copyright (C) 2005–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 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

App::Phoebe::WebDAV - add WebDAV to Phoebe wiki

=head1 DESCRIPTION

This allows users to mount the wiki as a remote server using WebDAV. If you
start it locally, for example, you should be able to mount
L<davs://localhost:1965/> as a remote server using your file manager (i.e.
Files, Finder, Windows Explorer, whatever it is called). Alternatively, you can
use a dedicated WebDAV client such as C<cadaver>.

If you want to have write access, you need to provide a username and password if
Phoebe requires a token. By default, the token required by Phoebe is "hello".
The username you provide is ignored. The password must match one of the tokens.

If you use a client such as C<cadaver>, it'll ask you for a username and
password when you use the "put" command for the first time. If you use the Gnome
Text Editor to edit the file, this fails. The fix is to mount
L<davs://localhost:1965/> instead. This forces Gnome Files to ask you for a
username and password, and once you provide it, Gnome Text Editor can save
files.

=head1 SEE ALSO

L<RFC 4918|https://datatracker.ietf.org/doc/html/rfc4918> defines WebDAV
including the PROPFIND method.

L<RFC 2616|https://datatracker.ietf.org/doc/html/rfc2616> defines HTTP/1.1
including the OPTION and PUT methods.

L<RFC 2617|https://datatracker.ietf.org/doc/html/rfc2617> defines Basic
Authentication.

=cut

package App::Phoebe::WebDAV;
use App::Phoebe::Web qw(handle_http_header);
use App::Phoebe qw(@request_handlers @extensions run_extensions $server
		   $log host_regex space_regex space port wiki_dir pages files
		   with_lock bogus_hash);
use File::Slurper qw(read_text write_text read_binary write_binary read_dir);
use HTTP::Date qw(time2str time2isoz);
use Digest::MD5 qw(md5_base64);
use Encode qw(encode_utf8 decode_utf8);
use Mojo::Util qw(b64_decode);
use File::stat;
use Modern::Perl;
use File::MimeInfo::Magic;
use URI::Escape;
use XML::LibXML;
use IO::Scalar;
use utf8;

unshift(@request_handlers, '^(OPTIONS|PROPFIND|PUT|DELETE|COPY|MOVE) .* HTTP/1\.1$' => \&handle_http_header);

# note that the requests handled here must be protected in
# App::Phoebe::RegisteredEditorsOnly!
push(@extensions, \&process_webdav);

sub process_webdav {
  my ($stream, $request, $headers, $buffer) = @_;
  my $hosts = host_regex();
  my $port = port($stream);
  my $spaces = space_regex();
  my ($method, $host, $space, $path, $id);
  if (($space, $path, $id)
      = $request =~ m!^OPTIONS (?:/($spaces))?(/(?:login|(?:file|page|raw)(?:/([^/]*))?)?)? HTTP/1\.1$!
      and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
    return if $path eq "/login" and not authorize($stream, $host, space($stream, $host, $space), $headers);
    options($stream, map { decode_utf8(uri_unescape($_)) } $path, $id);
  } elsif (($space, $path, $id)
	   = $request =~ m!^PROPFIND (?:/($spaces))?(/(?:login/?|(?:file|page|raw)(?:/([^/]*))?)?)? HTTP/1\.1$!
	   and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
    propfind($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers, $buffer);
  } elsif (($space, $path, $id)
	   = $request =~ m!^PUT (?:/($spaces))?(/(?:file|raw)/([^/]*)) HTTP/1\.1$!
	   and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
    put($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers, $buffer);
  } elsif (($space, $path, $id)
	   = $request =~ m!^DELETE (?:/($spaces))?(/(?:file|raw)/([^/]*)) HTTP/1\.1$!
	   and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
    remove($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers);
  } elsif (($space, $path, $id)
	   = $request =~ m!^COPY (?:/($spaces))?(/(?:file|raw)/([^/]*)) HTTP/1\.1$!
	   and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
    copy($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers);
  } elsif (($space, $path, $id)
	   = $request =~ m!^MOVE (?:/($spaces))?(/(?:file|raw)/([^/]*)) HTTP/1\.1$!
	   and ($host) = $headers->{host} =~ m!^($hosts)(?::$port)$!) {
    move($stream, $host, space($stream, $host, $space), (map { decode_utf8(uri_unescape($_)) } $path, $id), $headers);
  } else {
    return 0;
  }
  return 1;
}

my %implemented = (
  options  => '*',
  propfind => '*',
  get      => 'r', # handled by App::Phoebe::Web
  put      => 'w',
  delete   => 'w',
  copy     => 'w',
  move     => 'w',
);

sub options {
  my ($stream, $path, $id) = @_;
  my $allow = join(',', map { uc }
		   grep { $implemented{$_} eq '*'
		       or $implemented{$_} eq 'r' and $id
		       or $implemented{$_} eq 'w' and $id and $path =~ m!^/(raw|file)/.! }
		   keys %implemented);
  $log->debug("OPTIONS: $allow");
  $stream->write("HTTP/1.1 200 OK\r\n");
  $stream->write("DAV: 1\r\n");
  $stream->write("Allow: $allow\r\n");
  $stream->write("\r\n");
}

sub propfind {
  my ($stream, $host, $space, $path, $id, $headers, $buffer) = @_;
  $path //= "/";
  my $depth = $headers->{depth} // "infinity";
  $log->debug("PROPFIND depth: $depth");
  $log->debug("PROPFIND content: $buffer");

  my $parser = XML::LibXML->new;
  my $req;
  eval { $req = $parser->parse_string($buffer); };
  if ($@) {
    webdav_error($stream, "Cannot parse the PROPFIND body");
    $log->warn("PROPFIND parse: $@");
    return;
  }