Apache-Roaming
view release on metacpan or search on metacpan
ChangeLog Revision history
MANIFEST This file
MANIFEST.SKIP
Makefile.PL Makefile generator
README I mean it! :-)
lib/Apache/Roaming.pm The roaming access module
lib/Apache/Roaming/LiPrefs.pm A module for parsing liprefs files
lib/Bundle/Apache/Roaming.pm A bundle for CPAN installation
t/01base.t Base test (Loading the module)
t/10methods.t Testing the PUT, GET, MOVE and DELETE methods
t/20liprefs.t Testing Apache::Roaming::LiPrefs
http://www.esat.kuleuven.ac.be/~vermeule/roam/put
Compared to Apache::Roaming, this script doesn't need mod_perl. On the
other hand it doesn't support the MOVE method, thus you need to set the
li.prefs.http.useSimplePut attribute in your Netscape preferences. Due
to the missing MOVE method, it may be even slower than Apache::Roaming
and perhaps a little bit less stable.
The modules features are:
* GET, HEAD, PUT, DELETE and MOVE are handled by the module. In
particular the Non-standard MOVE method is implemented, although
Apache doesn't know it by default. Thus you need no set the
li.prefs.http.useSimplePut attribute to true.
* Directories are created automatically.
* The module is subclassable, so that you can create profiles on
the fly or parse and modify the user preferences. See the
Apache::Roaming::LiPrefs(3) manpage for an example subclass.
well use it by itself, but IMO the most important possibility is
overwriting the GET method for complete control over the users settings.
handler
$result = Apache::Roaming->handler($r);
(Class Method) The *handler* method is called by the Apache server for
any request. It receives an Apache request $r. The methods main task is
creating an instance of Apache::Roaming by calling the *new* method and
then passing control to the *Authenticate*, *CheckDir* and *GET*, *PUT*,
*DELETE* or *MOVE*, respectively, methods.
handler_type
$status = Apache::Roaming->handler_type($r)
(Class Method) This method is required only, because the Apache server
would refuse other methods than GET otherwise. It checks whether the
requested method is GET, PUT, HEAD, DELETE or MOVE, in which case it
returns the value OK. Otherwise the value DECLINED is returned.
new
$ar_req = Apache::Roaming->new(%attr);
(Class Method) This is the modules constructor, called by the *handler*
method. Instances of Apache::Request have the following attributes:
basedir The roaming servers base directory, as an absolute path. You set
this using a PerlSetVar instruction, see the INSTALLATION
manpage above for an example.
file This is the path of the file being created (PUT), read (GET),
deleted (DELETE) or moved (MOVE). It's an absolute path.
method The requested method, one of HEAD, GET, PUT, MOVE or DELETE.
request This is the Apache request object.
status If a method dies, it should set this value to a return code like
SERVER_ERROR (default), FORBIDDEN, METHOD_NOT_ALLOWED, or
something similar from Apache::Constants. See the
Apache::Constants(3) manpage. The *handler* method will catch
Perl exceptions for you and generate an error page.
user Name the user authenticated as.
CheckDir
$ar_req->CheckDir();
(Instance method) Once the user is authenticated, this method should
determine whether the user is permitted to access the requested URI. The
current implementation verifies whether the user is accessing a file in
the directory $basedir/$user. If not, a Perl exception is thrown with
$ar_req->{'status'} set to FORBIDDEN.
GET, PUT, MOVE, DELETE
$ar_req->GET();
$ar_req->PUT();
$ar_req->MOVE();
$ar_req->DELETE();
(Instance Methods) These methods are called finally for performing the
real action. With the exception of GET, they call *Success* finally for
reporting Ok.
Alternative method names are possible, depending on the name of the
requested file. For example, if you request the file *liprefs* via GET,
then it is checked whether your sublass has a method *GET_liprefs*. If
so, this method is called rather than the default method *GET*. The
alternative method names are obtained by removing all non-alpha- numeric
characters from the files base name. That is, if you request a file
*pab.na2*, then the alternative name is *pabna2*. Note, these method
names are case sensitive!
MkDir
$ar_req->MkDir($file);
(Instance Method) Helper function of *PUT*, creates the directory where
$file is located, if it doesn't yet exist. Works recursively, if more
than one directory must be created.
Success
$ar_req->Success($status, $text);
(Instance Method) Creates an HTML document with status $status,
containing $text as success messages.
lib/Apache/Roaming.pm view on Meta::CPAN
preferences. Due to the missing MOVE method, it may be even slower
than Apache::Roaming and perhaps a little bit less stable.
The modules features are:
=over 8
=item *
GET, HEAD, PUT, DELETE and MOVE are handled by the module. In particular
the Non-standard MOVE method is implemented, although Apache doesn't know
it by default. Thus you need no set the li.prefs.http.useSimplePut
attribute to true.
=item *
Directories are created automatically.
=item *
lib/Apache/Roaming.pm view on Meta::CPAN
=head2 handler
$result = Apache::Roaming->handler($r);
(Class Method) The I<handler> method is called by the Apache server
for any request. It receives an Apache request B<$r>. The methods
main task is creating an instance of Apache::Roaming by calling the
I<new> method and then passing control to the I<Authenticate>,
I<CheckDir> and I<GET>, I<PUT>, I<DELETE> or I<MOVE>, respectively,
methods.
=cut
sub handler ($$) {
my($class, $r) = @_;
my $file = File::Spec->canonpath(URI::Escape::uri_unescape($r->filename()));
if ($file=~/IMAP$/) {
lib/Apache/Roaming.pm view on Meta::CPAN
'request' => $r)
};
if ($@) {
$r->log_reason($@, $file);
return Apache::Constants::SERVER_ERROR();
}
eval {
$self->Authenticate();
$self->CheckDir();
if ($self->{'method'} !~ /(?:GET|PUT|DELETE|MOVE)/) {
$self->{'status'} = Apache::Constants::HTTP_METHOD_NOT_ALLOWED();
die "Unknown method: $self->{'method'}";
}
my $method = $self->{'method'};
my $f = File::Basename::basename($file);
$f =~ s/\W//g;
my $m = "$method\_$f";
UNIVERSAL::can($self, $m) ? $self->$m() : $self->$method();
};
lib/Apache/Roaming.pm view on Meta::CPAN
=pod
=head2 handler_type
$status = Apache::Roaming->handler_type($r)
(Class Method) This method is required only, because the Apache server
would refuse other methods than GET otherwise. It checks whether the
requested method is GET, PUT, HEAD, DELETE or MOVE, in which case it
returns the value OK. Otherwise the value DECLINED is returned.
=cut
sub handler_type ($$) {
my($class, $r) = @_;
if ($r->method() =~ /(?:GET|PUT|DELETE|MOVE)/) {
$r->handler('perl-script');
return Apache::Constants::OK();
}
return Apache::Constants::DECLINED();
}
=pod
=head2 new
lib/Apache/Roaming.pm view on Meta::CPAN
=over 8
=item basedir
The roaming servers base directory, as an absolute path. You set this
using a PerlSetVar instruction, see L<INSTALLATION> above for an
example.
=item file
This is the path of the file being created (PUT), read (GET), deleted
(DELETE) or moved (MOVE). It's an absolute path.
=item method
The requested method, one of HEAD, GET, PUT, MOVE or DELETE.
=item request
This is the Apache request object.
=item status
If a method dies, it should set this value to a return code like
SERVER_ERROR (default), FORBIDDEN, METHOD_NOT_ALLOWED, or something
similar from Apache::Constants. See L<Apache::Constants(3)>.
lib/Apache/Roaming.pm view on Meta::CPAN
}
$prevdir = $dir;
}
$self->{'status'} = Apache::Constants::FORBIDDEN();
die "Access to $file not permitted for user $user";
}
=pod
=head2 GET, PUT, MOVE, DELETE
$ar_req->GET();
$ar_req->PUT();
$ar_req->MOVE();
$ar_req->DELETE();
(Instance Methods) These methods are called finally for performing the
real action. With the exception of GET, they call I<Success> finally
for reporting Ok.
Alternative method names are possible, depending on the name of the
requested file. For example, if you request the file I<liprefs> via
GET, then it is checked whether your sublass has a method I<GET_liprefs>.
lib/Apache/Roaming.pm view on Meta::CPAN
$r->no_cache(1);
$r->header_out('content_length', $size);
$r->send_http_header();
if (!$r->header_only()) {
$r->send_fd($fh) or die $!;
}
return Apache::OK();
}
sub PUT {
my $self = shift;
my $file = $self->{'file'};
my $r = $self->{'request'};
$self->MkDir($file);
my $fh = Symbol::gensym();
open($fh, ">$file")
or die "Failed to open $file: $!";
lib/Apache/Roaming.pm view on Meta::CPAN
$self->Success(201, 'URI moved');
}
=pod
=head2 MkDir
$ar_req->MkDir($file);
(Instance Method) Helper function of I<PUT>, creates the directory
where $file is located, if it doesn't yet exist. Works recursively,
if more than one directory must be created.
=cut
sub MkDir {
my $self = shift; my $file = shift;
my $dir = File::Basename::dirname($file);
return if -d $dir;
$self->MkDir($dir);
t/10methods.t view on Meta::CPAN
alarm 120;
print "Creating a user agent.\n";
my $ua = LWP::UserAgent->new();
Test($ua);
sleep 5;
my $contents = 'abcdef';
my $testfile = File::Spec->catdir($cfg->{'roaming_dir'}, "foo bar", "test");
unlink $testfile;
Request($ua, 'PUT', '/roaming/foo bar/test', 'text/plain', $contents);
TestContents($testfile, $contents);
my $block = '';
for (my $i = 0; $i < 256; $i++) {
$block .= chr($i);
}
my $contents2 = $block x 40;
my $testfile2 = File::Spec->catdir($cfg->{'roaming_dir'}, "foo bar", "test2");
unlink $testfile2;
Request($ua, 'PUT', '/roaming/foo bar/test2', 'text/plain', $contents2);
TestContents($testfile2, $contents2);
my $res = Request($ua, 'GET', '/roaming/foo bar/test');
Test($res->content() and ($res->content() eq $contents));
$res = Request($ua, 'GET', '/roaming/foo bar/test2');
Test($res->content() and ($res->content() eq $contents2));
my $testfile3 = File::Spec->catdir($cfg->{'roaming_dir'}, "foo bar", "test3");
unlink $testfile3;
t/20liprefs.t view on Meta::CPAN
alarm 120;
print "Creating a user agent.\n";
my $ua = LWP::UserAgent->new();
Test($ua);
sleep 5;
my $contents = 'abcdef';
my $testfile = File::Spec->catdir($cfg->{'roaming_dir'}, "foo bar", "test");
unlink $testfile;
Request($ua, 'PUT', '/roaming/foo bar/test', 'text/plain', $contents);
TestContents($testfile, $contents);
my $block = '';
for (my $i = 0; $i < 256; $i++) {
$block .= chr($i);
}
my $contents2 = $block x 40;
my $testfile2 = File::Spec->catdir($cfg->{'roaming_dir'}, "foo bar", "test2");
unlink $testfile2;
Request($ua, 'PUT', '/roaming/foo bar/test2', 'text/plain', $contents2);
TestContents($testfile2, $contents2);
my $res = Request($ua, 'GET', '/roaming/foo bar/test');
Test($res->content() and ($res->content() eq $contents));
$res = Request($ua, 'GET', '/roaming/foo bar/test2');
Test($res->content() and ($res->content() eq $contents2));
my $testfile3 = File::Spec->catdir($cfg->{'roaming_dir'}, "foo bar", "test3");
unlink $testfile3;
( run in 0.344 second using v1.01-cache-2.11-cpan-4e96b696675 )