comparison extra/svn/SoundSoftware.pm @ 7:3c16ed8faa07 yuya

* Add start of custom version of Apache mod_perl authentication module

+package Apache::Authn::SoundSoftware;
+
+=head1 Apache::Authn::SoundSoftware
+
+SoundSoftware - a mod_perl module for Apache authentication against a
+Redmine database and optional LDAP implementing the access control
+rules required for the SoundSoftware.ac.uk repository site.
+
+=head1 SYNOPSIS
+
+This module is closely based on the Redmine.pm authentication module
+provided with Redmine.  It is intended to be used for authentication
+in front of a repository service such as hgwebdir.
+
+Requirements:
+
+1. Clone/pull from repo for public project: Any user, no
+authentication required
+
+2. Clone/pull from repo for private project: Project members only
+
+3. Push to repo for public project: "Permitted" users only (this
+probably means project members who are also identified in the hgrc web
+section for the repository and so will be approved by hgwebdir?)
+
+4. Push to repo for private project: "Permitted" users only (as above)
+
+=head1 INSTALLATION
+
+Debian/ubuntu:
+
+  apt-get install libapache-dbi-perl libapache2-mod-perl2 \
+    libdbd-mysql-perl libauthen-simple-ldap-perl libio-socket-ssl-perl
+
+Note that LDAP support is hardcoded "on" in this script (it is
+optional in the original Redmine.pm).
+
+=head1 CONFIGURATION
+
+   ## This module has to be in your perl path
+   ## eg:  /usr/local/lib/site_perl/Apache/Authn/SoundSoftware.pm
+   PerlLoadModule Apache::Authn::SoundSoftware
+
+   # Example when using hgwebdir
+   ScriptAlias / "/var/hg/hgwebdir.cgi/"
+
+   <Location />
+       AuthName "Mercurial"
+       AuthType Basic
+       Require valid-user
+       PerlAccessHandler Apache::Authn::SoundSoftware::access_handler
+       PerlAuthenHandler Apache::Authn::SoundSoftware::authen_handler
+       SoundSoftwareDSN "DBI:mysql:database=redmine;host=localhost"
+       SoundSoftwareDbUser "redmine"
+       SoundSoftwareDbPass "password"
+       Options +ExecCGI
+       AddHandler cgi-script .cgi
+       ## Optional where clause (fulltext search would be slow and
+       ## database dependant).
+       # SoundSoftwareDbWhereClause "and members.role_id IN (1,2)"
+       ## Optional credentials cache size
+       # SoundSoftwareCacheCredsMax 50
+  </Location>
+
+See the original Redmine.pm for further configuration notes.
+
+=cut
+
+use strict;
+use warnings FATAL => 'all', NONFATAL => 'redefine';
+
+use DBI;
+use Digest::SHA1;
+use Authen::Simple::LDAP;
+use Apache2::Module;
+use Apache2::Access;
+use Apache2::ServerRec qw();
+use Apache2::RequestRec qw();
+use Apache2::RequestUtil qw();
+use Apache2::Const qw(:common :override :cmd_how);
+use APR::Pool ();
+use APR::Table ();
+
+# use Apache2::Directive qw();
+
+my @directives = (
+  {
+    name => 'SoundSoftwareDSN',
+    req_override => OR_AUTHCFG,
+    args_how => TAKE1,
+    errmsg => 'Dsn in format used by Perl DBI. eg: "DBI:Pg:dbname=databasename;host=my.db.server"',
+  },
+  {
+    name => 'SoundSoftwareDbUser',
+    req_override => OR_AUTHCFG,
+    args_how => TAKE1,
+  },
+  {
+    name => 'SoundSoftwareDbPass',
+    req_override => OR_AUTHCFG,
+    args_how => TAKE1,
+  },
+  {
+    name => 'SoundSoftwareDbWhereClause',
+    req_override => OR_AUTHCFG,
+    args_how => TAKE1,
+  },
+  {
+    name => 'SoundSoftwareCacheCredsMax',
+    req_override => OR_AUTHCFG,
+    args_how => TAKE1,
+    errmsg => 'SoundSoftwareCacheCredsMax must be decimal number',
+  },
+);
+
+sub SoundSoftwareDSN { 
+  my ($self, $parms, $arg) = @_;
+  $self->{SoundSoftwareDSN} = $arg;
+  my $query = "SELECT 
+                 hashed_password, auth_source_id, permissions
+              FROM members, projects, users, roles, member_roles
+              WHERE 
+                projects.id=members.project_id
+                AND member_roles.member_id=members.id
+                AND users.id=members.user_id 
+                AND roles.id=member_roles.role_id
+                AND users.status=1 
+                AND login=? 
+                AND identifier=? ";
+  $self->{SoundSoftwareQuery} = trim($query);
+}
+
+sub SoundSoftwareDbUser { set_val('SoundSoftwareDbUser', @_); }
+sub SoundSoftwareDbPass { set_val('SoundSoftwareDbPass', @_); }
+sub SoundSoftwareDbWhereClause { 
+  my ($self, $parms, $arg) = @_;
+  $self->{SoundSoftwareQuery} = trim($self->{SoundSoftwareQuery}.($arg ? $arg : "")." ");
+}
+
+sub SoundSoftwareCacheCredsMax { 
+  my ($self, $parms, $arg) = @_;
+  if ($arg) {
+    $self->{SoundSoftwareCachePool} = APR::Pool->new;
+    $self->{SoundSoftwareCacheCreds} = APR::Table::make($self->{SoundSoftwareCachePool}, $arg);
+    $self->{SoundSoftwareCacheCredsCount} = 0;
+    $self->{SoundSoftwareCacheCredsMax} = $arg;
+  }
+}
+
+sub trim {
+  my $string = shift;
+  $string =~ s/\s{2,}/ /g;
+  return $string;
+}
+
+sub set_val {
+  my ($key, $self, $parms, $arg) = @_;
+  $self->{$key} = $arg;
+}
+
+Apache2::Module::add(__PACKAGE__, \@directives);
+
+
+my %read_only_methods = map { $_ => 1 } qw/GET PROPFIND REPORT OPTIONS/;
+
+sub access_handler {
+  my $r = shift;
+
+  print STDERR "SoundSoftware.pm: In access handler\n";
+
+  unless ($r->some_auth_required) {
+      $r->log_reason("No authentication has been configured");
+      return FORBIDDEN;
+  }
+
+  my $method = $r->method;
+
+  print STDERR "SoundSoftware.pm: Method: $method, uri " . $r->uri . ", location " . $r->location . "\n";
+
+  if (!defined $read_only_methods{$method}) {
+      print STDERR "SoundSoftware.pm: Method is not read-only, authentication handler required\n";
+      return OK;
+  }
+
+  my $project_id = get_project_identifier($r);
+
+  if (defined $project_id) {
+      print STDERR "SoundSoftware.pm: Project: $project_id\n";
+  } else {
+      print STDERR "SoundSoftware.pm: No project identifier available, refusing access\n";
+      return FORBIDDEN;
+  }
+
+  my $status = get_project_status($project_id, $r);
+
+  if ($status == 0) { # nonexistent
+      print STDERR "SoundSoftware.pm: Project does not exist, refusing access\n";
+      return FORBIDDEN;
+  } elsif ($status == 1) { # public
+      print STDERR "SoundSoftware.pm: Project is public, no restriction here\n";
+      $r->set_handlers(PerlAuthenHandler => [\&OK])
+  } else { # private
+      print STDERR "SoundSoftware.pm: Project is not public, authentication handler required\n";
+  }
+
+  return OK
+}
+
+sub authen_handler {
+  my $r = shift;
+ 
+  print STDERR "SoundSoftware.pm: In authentication handler\n";
+ 
+  my ($res, $redmine_pass) =  $r->get_basic_auth_pw();
+  return $res unless $res == OK;
+  
+  print STDERR "SoundSoftware.pm: User is " . $r->user . ", got password\n";
+
+  if (is_member($r->user, $redmine_pass, $r)) {
+      return OK;
+  } else {
+      print STDERR "SoundSoftware.pm: Failed to validate project membership\n";
+      $r->note_auth_failure();
+      return AUTH_REQUIRED;
+  }
+}
+
+sub get_project_status {
+    my $project_id = shift;
+    my $r = shift;
+    
+    my $dbh = connect_database($r);
+    my $sth = $dbh->prepare(
+        "SELECT is_public FROM projects WHERE projects.identifier = ?;"
+    );
+
+    $sth->execute($project_id);
+    my $ret = 0;
+    if (my @row = $sth->fetchrow_array) {
+    	if ($row[0] eq "1" || $row[0] eq "t") {
+	    $ret = 1; # public
+    	} else {
+	    $ret = 2; # private (0 means nonexistent)
+	}
+    }
+    $sth->finish();
+    undef $sth;
+    $dbh->disconnect();
+    undef $dbh;
+
+    $ret;
+}
+
+sub is_member {
+  my $redmine_user = shift;
+  my $redmine_pass = shift;
+  my $r = shift;
+
+  my $dbh         = connect_database($r);
+  my $project_id  = get_project_identifier($r);
+
+  my $pass_digest = Digest::SHA1::sha1_hex($redmine_pass);
+
+  my $cfg = Apache2::Module::get_config(__PACKAGE__, $r->server, $r->per_dir_config);
+  my $usrprojpass;
+  if ($cfg->{SoundSoftwareCacheCredsMax}) {
+    $usrprojpass = $cfg->{SoundSoftwareCacheCreds}->get($redmine_user.":".$project_id);
+    return 1 if (defined $usrprojpass and ($usrprojpass eq $pass_digest));
+  }
+  my $query = $cfg->{SoundSoftwareQuery};
+  my $sth = $dbh->prepare($query);
+  $sth->execute($redmine_user, $project_id);
+
+  my $ret;
+  while (my ($hashed_password, $auth_source_id, $permissions) = $sth->fetchrow_array) {
+
+      unless ($auth_source_id) {
+	  my $method = $r->method;
+          if ($hashed_password eq $pass_digest && ((defined $read_only_methods{$method} && $permissions =~ /:browse_repository/) || $permissions =~ /:commit_access/) ) {
+              $ret = 1;
+              last;
+          }
+      } else {
+          my $sthldap = $dbh->prepare(
+              "SELECT host,port,tls,account,account_password,base_dn,attr_login from auth_sources WHERE id = ?;"
+          );
+          $sthldap->execute($auth_source_id);
+          while (my @rowldap = $sthldap->fetchrow_array) {
+            my $ldap = Authen::Simple::LDAP->new(
+                host    =>      ($rowldap[2] eq "1" || $rowldap[2] eq "t") ? "ldaps://$rowldap[0]" : $rowldap[0],
+                port    =>      $rowldap[1],
+                basedn  =>      $rowldap[5],
+                binddn  =>      $rowldap[3] ? $rowldap[3] : "",
+                bindpw  =>      $rowldap[4] ? $rowldap[4] : "",
+                filter  =>      "(".$rowldap[6]."=%s)"
+            );
+            my $method = $r->method;
+            $ret = 1 if ($ldap->authenticate($redmine_user, $redmine_pass) && ((defined $read_only_methods{$method} && $permissions =~ /:browse_repository/) || $permissions =~ /:commit_access/));
+
+          }
+          $sthldap->finish();
+          undef $sthldap;
+      }
+  }
+  $sth->finish();
+  undef $sth;
+  $dbh->disconnect();
+  undef $dbh;
+
+  if ($cfg->{SoundSoftwareCacheCredsMax} and $ret) {
+    if (defined $usrprojpass) {
+      $cfg->{SoundSoftwareCacheCreds}->set($redmine_user.":".$project_id, $pass_digest);
+    } else {
+      if ($cfg->{SoundSoftwareCacheCredsCount} < $cfg->{SoundSoftwareCacheCredsMax}) {
+        $cfg->{SoundSoftwareCacheCreds}->set($redmine_user.":".$project_id, $pass_digest);
+        $cfg->{SoundSoftwareCacheCredsCount}++;
+      } else {
+        $cfg->{SoundSoftwareCacheCreds}->clear();
+        $cfg->{SoundSoftwareCacheCredsCount} = 0;
+      }
+    }
+  }
+
+  $ret;
+}
+
+sub get_project_identifier {
+    my $r = shift;
+
+    my $location = $r->location;
+    my ($repo) = $r->uri =~ m{$location/*([^/]+)};
+    $repo =~ s/[^a-zA-Z0-9\._-]//g;
+
+    my $dbh = connect_database($r);
+    my $sth = $dbh->prepare(
+        "SELECT projects.identifier FROM projects, repositories WHERE repositories.project_id = projects.id AND repositories.url LIKE ?;"
+    );
+
+    my $identifier = '';
+
+    $sth->execute('%/' . $repo);
+    my $ret = 0;
+    if (my @row = $sth->fetchrow_array) {
+	$identifier = $row[0];
+    }
+    $sth->finish();
+    undef $sth;
+    $dbh->disconnect();
+    undef $dbh;
+
+    print STDERR "SoundSoftware.pm: Repository $repo belongs to project $identifier\n";
+
+    $identifier;
+}
+
+sub connect_database {
+    my $r = shift;
+    
+    my $cfg = Apache2::Module::get_config(__PACKAGE__, $r->server, $r->per_dir_config);
+    return DBI->connect($cfg->{SoundSoftwareDSN}, $cfg->{SoundSoftwareDbUser}, $cfg->{SoundSoftwareDbPass});
+}
+
+1;