Hol' mehr aus deinem CMS mit WebDAV

Michael Kröll <pepl@cpan.org>

Was ist WebDAV?

Warum WebDAV?

WebDAV Klienten

WebDAV und Content Management

Eine WebDAV-Implementierung am Beispiel XIMS Web-CMS

mod_perl handler godav.pm

handler

01sub handler {
02  my $r = shift;
03  my $method = lc $r->method;
04  my $path   = Apache::URI::uri_unescape($r->uri);
05
06  # Fetch the user set by the Auth Handler
07  my $user =  $r->pnotes( 'ximsBasicAuthUser' );
08  return (403) unless defined $user;
09
10  # Tell MS Webfolders that we are not a Frontpage Server Extensions-,
11  # but a WebDAV server
12  $r->header_out( 'MS-Author-Via', 'DAV' );
13

handler (fortgesetzt)

14  # Dispatch to method handler
15  no strict 'refs';
16  my ($status_code, $content) = &{$method}( $r, $user );
17  use strict 'refs';
18
19  $r->status( $status_code );
20  if ( defined $content ) {
21    my $bytes;
22    do { use bytes; $bytes = length($content) };
23    $r->header_out( 'Content-Length', $bytes );
24    $r->send_http_header();
25    $r->print( $content );
26  }
27  else {
28    $r->send_http_header();
29  }
30}

mkcol (Erstellen von Ordnern)

1sub mkcol {
2  my $r = shift;
3  my $user = shift;
4
5  my $path = uri_unescape( $r->path_info() );
6  $path =~ s#/$##;
7  my $object = XIMS::Object->new( User => $user, path => $path,
8                                  marked_deleted => undef );
9
10  # Content-Length headers are not supposed to be here
11  if ( $r->header_in( 'Content-Length') ) {
12    return (415); Unsupported Media Type
13  }

mkcol (fortgesetzt)

14  elsif ( not defined $object ) {
15    my ($parentpath) = ( $path =~ m|^(.*)/[^/]+$| );
16    my $parent = XIMS::Object->new( User => $user, path => $parentpath,
17                                    marked_deleted => undef );
18    return (409) unless (defined $parent and defined $parent->id()); # Conflict
19
20    my $privmask = $user->object_privmask( $parent );
21    return (403) unless $privmask & XIMS::Privileges::CREATE();

mkcol (fortgesetzt)

22    my $importer = XIMS::Importer::Object->new( User => $user,
23                                                Parent => $parent );
24    my ($location) = ( $path =~ m|([^/]+)$| );
25    my $folder = XIMS::Folder->new( User => $user,
26                                    location => $location );
27    if ( not $importer->import( $folder ) ) {
28        return (405); # Method not allowed
29    }
30  }
31  else {
32    return (405);
33  }
34  return (201); # Created
35}

Weitere Methoden

options, propfind, put, get, delete, lock, unlock, copy und move

Weiterführende Informationen

Vielen Dank!

Fragen?