package Apache::AuthzUnix;
our $VERSION = '0.02';
our $DEBUG   = 0;
require File::stat;
use File::Basename qw(dirname);
use User::pwent;
use User::grent;

use constant MP2 =>
  ~~(exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2);

BEGIN {
    my @constants = qw( OK DECLINED );
    if (MP2) {
        require Apache2::Access;
        require Apache2::RequestRec;
        require Apache2::Const;
        import Apache2::Const @constants;
    }
    else {
        require Apache::Constants;
        import Apache::Constants @constants;
    }
}

sub authz {
    my $r    = shift;
    my $user = $r->user or return DECLINED();
    my $fn   = $r->filename;

    if (!-e $r->filename) { $fn = dirname($fn) }
# Why did we just do that? Because:
#  If we're PUTting a file, we want to check if we can write to the directory.
#  Otherwise, we're GETting a non-existent or autogenerated file (ie autoindex)
#     If it's a directory index, then we use the permissions of the directory.
#     If it's non-existent, permissions are an irrelevance!

    my $stat       = File::stat::stat($fn);
    my $access     =
      _access($user, $stat->mode, $stat->uid, $stat->gid, $r->method);
    warn "Access to file: "
      . $r->filename
      . " (resolved as $fn) : "
      . ($access ? "allowed" : "denied")
      if $DEBUG;
    return $access ? OK() : DECLINED();
}

sub _access {
    my ($username, $perms, $uid, $gid, $method) = @_;
    my ($u, $g, $o) = ($perms & 0700, $perms & 0070, $perms & 0007);
    my $user        = getpwnam($username);
    my %in_group    = map { $_ => 1 } @{ getgrgid($gid)->members };
    my $bit         = $method =~ /(PUT|DELETE)/ ? 2 : 4;

    return 1 if $o & $bit
             || ($uid == $user->uid and $u & ($bit << 6))
             || (($gid == $user->gid or $in_group{$username}) 
                 and $g & ($bit << 3));
    return 0;
}

1;
__END__
# Below is stub documentation for your module. You'd better edit it!

=head1 NAME

Apache::AuthzUnix - Apache/Apache2 authorization handler for Unix permissions

=head1 SYNOPSIS

  PerlModule Apache::AuthzUnix;
  <Location ...>
    AuthName auth
    AuthType Basic
    AuthBasicProvider ldap
    PerlAuthzHandler Apache::AuthzUnix::authz
    # Don't need a "requires" line
  </Location>

=head1 DESCRIPTION

This module was written to provide authorization for DAV access to home
directories, but probably has other uses in the C<UserDir> space. 

Assuming that Apache has authenticated a user, this module helps to
determine whether or not that user can read (or write) a file on the
filesystem. It applies standard Unix user and group tests on the file's
permissions to determine read access and, in the case of C<PUT> and
C<DELETE> methods, write access. If the file does not exist, then the 
containing directory is tested, as one would expect.

This module is designed work on both mod_perl versions 1 and 2.

=head1 AUTHOR

Simon Cozens, E<lt>simon@simon-cozens.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2007 by Simon Cozens

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.7 or,
at your option, any later version of Perl 5 you may have available.


=cut