blob: b09875755a8de0d46f05d862e00a2a93a52433ae (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
#!/usr/bin/perl -w
# This script requires the following Perl modules:
#
# $ perl -MCPAN -e 'shell'
# cpan> install Net::DAV::Server
# cpan> install Filesys::Virtual::Plain
# cpan> install File::Find::Rule::Filesys::Virtual
# cpan> install XML::LibXML
#
# The last Perl module needs the libxml2 development libraries installed
# (the libxml2-dev package on Debian).
use Net::DAV::Server;
use Filesys::Virtual::Plain;
use HTTP::Daemon;
# If 1, output request and response headers
my $DEBUG=0;
my $filesys = Filesys::Virtual::Plain->new();
$filesys->root_path('/tmp');
$filesys->cwd('/tmp');
#print foreach ($filesys->list('/'));
my $webdav = Net::DAV::Server->new();
$webdav->filesys($filesys);
my $d = new HTTP::Daemon
LocalAddr => 'localhost',
LocalPort => 4242,
ReuseAddr => 1 || die;
print "Please contact me at: ", $d->url, "\n";
while (my $c = $d->accept) {
while (my $request = $c->get_request) {
if ( $DEBUG ) {
print qq|------------------------------------------------------------
REQUEST
------------------------------------------------------------\n|;
while ( ($k,$v) = each %{$request} ) {
print " $k => $v\n";
}
}
my $response = $webdav->run($request);
if ( $DEBUG ) {
print qq|------------------------------------------------------------
RESPONSE
------------------------------------------------------------\n|;
while ( ($k,$v) = each %{$response} ) {
print " $k => $v\n";
}
}
$c->send_response ($response);
}
$c->close;
undef($c);
}
|
