| Description: |
This is a small WebDAV server I use for serving files to other people. WebDAV is quite convenient for serving files because "all three" operating systems offer a client that allows you to treat a WebDAV share as a remote file system. It extends the sample code of Net::DAV::Server to provide HTTP basic authentication, so it can be exposed on the internet without being completely open.
I've implemented a separation of privileges into "readers" and "writers", but so far I haven't felt the need to export write privileges. So maybe that part shouldn't have been written at all, in the spirit of Dominus.
On the side of prerequisites, this one is quite heavy. It uses Net::DAV::Server, which in turn pulls in XML::LibXML. It uses Filesys::Virtual, Authen::Htpasswd and HTTP::Daemon. |
#!/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);
}
|
