#!/opt/perl/bin/perl5.8.8 -w
use strict;

use Net::DAV::Server;
use Filesys::Virtual::Plain;
use Authen::Htpasswd;
use HTTP::Daemon;
use Cwd;
use Getopt::Long;
use Pod::Usage;

use vars qw($filesys $webdav $can_read $can_write
%permissions
$VERSION);

$VERSION = '0.01';

GetOptions(
    'host:s' => \my $host,
    'port:i' => \my $port,
    'version' => \my $print_version,
    'readers:s' => \my $reader_file,
    'writers:s' => \my $writer_file,
    'path:s' => \my $path,
    'verbose' => \my $verbose,
    'horribly-unsafe' => \my $horribly_unsafe,
    'add-user' => \my $do_add_user,
) || pod2usage(1);

$host ||= 'localhost';
$port ||= 4242;
$reader_file ||= 'readers.htpasswd';
$path ||= getcwd;

$can_read = Authen::Htpasswd->new($reader_file, { encrypt_hash => 'md5
+' });
if ($writer_file) {
    $can_write = Authen::Htpasswd->new($writer_file, { encrypt_hash =>
+ 'md5' });
};

if ($do_add_user) {
    $can_read->update_user(@ARGV);
    print "Added user $ARGV[0] with password $ARGV[1]\n";
    exit
};

%permissions = (
    options  => [ 1 ],
    put      => [ $can_write ],
    get      => [ $can_read, $can_write ],
    head     => [ $can_read, $can_write ],
    post     => [ $can_write ],
    delete   => [ $can_write ],
    trace    => [ $can_read, $can_write ],
    mkcol    => [ $can_write ],
    propfind => [ $can_read, $can_write ],
    copy     => [ $can_write ],
    lock     => [ $can_write ],
    unlock   => [ $can_write ],
    move     => [ $can_write ],
);

$filesys = Filesys::Virtual::Plain->new({root_path => $path});
$webdav = Net::DAV::Server->new();
$webdav->filesys($filesys);
my $d = HTTP::Daemon->new(
    LocalAddr => $host,
    LocalPort => $port,
    ReuseAddr => 1,
) or die "Couldn't create daemon on port $host:$port.";

print "Please contact me at: ", $d->url, "\n";
while (my $c = $d->accept) {
    while (my $request = $c->get_request) {
        my $method = lc $request->method;
        #warn $request->as_string;
        my ($username,$pass) = $request->authorization_basic;
        #warn "User >$username< Pass >$pass<";
        (my $allowed) = (grep { eval { ref $_ ? $_->check_user_passwor
+d($username,$pass) : $_ } }
                        grep { defined $_ } (@{ $permissions{ $method 
+}}));
        $allowed ||= $horribly_unsafe;
        my $response = HTTP::Response->new;
        if ($allowed) {
            $response = $webdav->run($request);
        } else {
            $response->code('401');
            $response->www_authenticate('Basic realm="DAV Server $VERS
+ION"');
            $response->message('Access denied');
        };
        warn "Response: " . $response->code
            if $verbose;
        $c->send_response($response);
    }
    $c->close;
    undef($c);
}

[download]

In reply to A WebDAV server with authentication by Corion

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.